Define meta and replace.

src/Sound/Tidal/Pattern.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-
@@ -563,6 +564,30 @@ tParam3 f a b c p = innerJoin $ (\x y z -> f x y z p) <$> a <*> b <*> c
 tParamSqueeze :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c)
 tParamSqueeze f tv p = squeezeJoin $ (`f` p) <$> tv
 
+-- | `meta` resembles `Applicative`: whereas
+-- `<*>`  has type `f (  a ->   b) -> f a -> f b`,
+-- `meta` has type `f (f a -> f b) -> f a -> f b`.
+--
+-- Here's a minimal example. It plays the pattern "ho*8"
+-- at normal speed for the first half,
+-- and at double speed for the second half.
+-- `let slang = [ (0, id)
+--              , (1, fast 2) ]
+--    in p 1 $ meta (replace slang "0 1") "ho*8"`
+meta :: forall a b.
+        Pattern (Pattern a -> Pattern b) -> Pattern a -> Pattern b
+meta pf pa = Pattern { query = q } where
+  q :: State -> [Event b]
+  q s = let
+    changes :: [ Event (Pattern a -> Pattern b) ]
+    changes = query pf s
+    ap :: Event (Pattern a -> Pattern b) -> [Event b]
+    ap c = query (value c pa)
+           $ State { arc = part c,
+                     controls = controls s }
+    in concatMap ap changes
+
+
 -- ** Context
 
 combineContexts :: [Context] -> Context

src/Sound/Tidal/UI.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings, ScopedTypeVariables #-}
 
 module Sound.Tidal.UI where
 
@@ -29,7 +29,7 @@ import           Data.Bits (testBit, Bits, xor, shiftL, shiftR)
 import           Data.Ratio ((%), Ratio)
 import           Data.Fixed (mod')
 import           Data.List (sort, sortOn, findIndices, elemIndex, groupBy, transpose, intercalate, findIndex)
-import           Data.Maybe (isJust, fromJust, fromMaybe, mapMaybe)
+import           Data.Maybe (isJust, fromJust, fromMaybe, mapMaybe, catMaybes)
 import qualified Data.Text as T
 import qualified Data.Map.Strict as Map
 import           Data.Bool (bool)
@@ -1376,6 +1376,29 @@ ur t outer_p ps fs = _slow t $ unwrap $ adjust <$> timedValues (getPat . split <
         matchF str = fromMaybe id $ lookup str fs
         timedValues = withEvent (\(Event c (Just a) a' v) -> Event c (Just a) a' (a,v)) . filterDigital
 
+-- | `replace` uses a lookup table to transform a
+-- `Pattern a` into a `Pattern b`.
+-- Anything not found in the lookup table is discarded.
+-- `replace` is, useful to create the first argument to `meta`
+-- (that is, the `Pattern (Pattern a -> Pattern b)`.
+replace :: forall a b. Ord a =>
+           [(a,b)] -> Pattern a -> Pattern b
+replace pairs pat = let
+  -- Since `Pattern` is a `Functor`,
+  -- there might be an easier way,
+  -- but the `Maybe` makes a simple `fmap` unworkable.
+  f :: a -> Maybe b
+  f a = Map.lookup a $ Map.fromList pairs
+  rep :: Event a -> Maybe (Event b)
+  rep ea = let mb :: Maybe b
+               mb = f $ value ea
+    in case mb of
+         Nothing -> Nothing
+         Just b -> Just $ ea { value   = b }
+  q :: State -> [Event b]
+  q s = catMaybes $ map rep $ query pat s
+  in Pattern {query = q}
+
 inhabit :: [(String, Pattern a)] -> Pattern String -> Pattern a
 inhabit ps p = squeezeJoin $ (\s -> fromMaybe silence $ lookup s ps) <$> p