expand and contract

src/Sound/Tidal/Pattern.hs

@@ -225,19 +225,19 @@ unwrap pp = pp {query = q, pureValue = Nothing}
 -- but structure only comes from the inner pattern.
 innerJoin :: Pattern (Pattern a) -> Pattern a
 innerJoin pp = setTactus (Just $ innerJoin' $ filterJust $ tactus <$> pp) $ innerJoin' pp
-
--- | innerJoin but without tactus manipulation (just to avoid recursion)
-innerJoin' :: Pattern (Pattern a) -> Pattern a
-innerJoin' pp = pp {query = q, pureValue = Nothing}
-  where q st = concatMap
-               (\(Event oc _ op v) -> mapMaybe (munge oc) $ query v st {arc = op}
-          )
-          (query pp st)
-          where munge oc (Event ic iw ip v) =
-                  do
-                    p <- subArc (arc st) ip
-                    p' <- subArc p (arc st)
-                    return (Event (combineContexts [ic, oc]) iw p' v)
+  where
+    -- | innerJoin but without tactus manipulation (to avoid recursion)
+    innerJoin' :: Pattern (Pattern b) -> Pattern b
+    innerJoin' pp = pp {query = q, pureValue = Nothing}
+      where q st = concatMap
+                  (\(Event oc _ op v) -> mapMaybe (munge oc) $ query v st {arc = op}
+              )
+              (query pp st)
+              where munge oc (Event ic iw ip v) =
+                      do
+                        p <- subArc (arc st) ip
+                        p' <- subArc p (arc st)
+                        return (Event (combineContexts [ic, oc]) iw p' v)
 
 -- | Turns a pattern of patterns into a single pattern. Like @unwrap@,
 -- but structure only comes from the outer pattern.
@@ -256,6 +256,7 @@ outerJoin pp = pp {query = q, pureValue = Nothing}
 -- | Like @unwrap@, but cycles of the inner patterns are compressed to fit the
 -- timespan of the outer whole (or the original query if it's a continuous pattern?)
 -- TODO - what if a continuous pattern contains a discrete one, or vice-versa?
+-- TODO - tactus
 squeezeJoin :: Pattern (Pattern a) -> Pattern a
 squeezeJoin pp = pp {query = q, pureValue = Nothing}
   where q st = concatMap

src/Sound/Tidal/Stepwise.hs

@@ -91,6 +91,20 @@ decrease npat pat@(Pattern _ (Just tpat) _) = increase (f <$> tpat <*> npat) pat
    where f t n | n >= 0 = t - n
                | otherwise = 0 - (t + n)
 
+_expand :: Rational -> Pattern a -> Pattern a
+_expand factor pat = withTactus (* factor) pat
+
+_contract :: Rational -> Pattern a -> Pattern a
+_contract factor pat = withTactus (/ factor) pat
+
+expand :: Pattern Rational -> Pattern a -> Pattern a
+expand = s_patternify _expand
+
+contract :: Pattern Rational -> Pattern a -> Pattern a
+contract = s_patternify _contract
+
+
+
 {-
 s_while :: Pattern Bool -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
 s_while patb f pat@(Pattern _ (Just t) _) = while (_steps t patb) f pat
@@ -162,16 +176,4 @@ s_alt :: [[Pattern a]] -> Pattern a
 s_alt groups = s_cat $ concat $ take (c * length groups) $ transpose $ map cycle groups
   where c = foldl1 lcm $ map length groups
 
-_s_expand :: Rational -> Pattern a -> Pattern a
-_s_expand factor pat = withTactus (* factor) pat
-
-_s_contract :: Rational -> Pattern a -> Pattern a
-_s_contract factor pat = withTactus (/ factor) pat
-
-s_expand :: Pattern Rational -> Pattern a -> Pattern a
-s_expand = s_patternify _s_expand
-
-s_contract :: Pattern Rational -> Pattern a -> Pattern a
-s_contract = s_patternify _s_contract
-
 -}