preserve/calculate tactus correctly across applicatives

src/Sound/Tidal/Pattern.hs

@@ -79,7 +79,7 @@ steps = tParam _steps
 keepMeta :: Pattern a -> Pattern a -> Pattern a
 keepMeta from to = to {tactus = tactus from, pureValue = pureValue from}
 
-keepTactus :: Pattern a -> Pattern a -> Pattern a
+keepTactus :: Pattern a -> Pattern b -> Pattern b
 keepTactus from to = to {tactus = tactus from}
 
 -- type StateMap = Map.Map String (Pattern Value)
@@ -121,19 +121,19 @@ instance Applicative Pattern where
   -- > (⅓>½)-⅔|11
   -- > ⅓-(½>⅔)|12
   -- >   (⅔>1)|102
-  (<*>) = applyPatToPatBoth
+  (<*>) a b = (applyPatToPatBoth a b) {tactus = lcmr <$> tactus a <*> tactus b }
 
 -- | Like @<*>@, but the "wholes" come from the left
 (<*) :: Pattern (a -> b) -> Pattern a -> Pattern b
-(<*) = applyPatToPatLeft
+(<*) a b = keepTactus a $ applyPatToPatLeft a b
 
 -- | Like @<*>@, but the "wholes" come from the right
 (*>) :: Pattern (a -> b) -> Pattern a -> Pattern b
-(*>) = applyPatToPatRight
+(*>) a b = keepTactus b $ applyPatToPatRight a b
 
 -- | Like @<*>@, but the "wholes" come from the left
 (<<*) :: Pattern (a -> b) -> Pattern a -> Pattern b
-(<<*) = applyPatToPatSqueeze
+(<<*) a b = (applyPatToPatSqueeze a b) {tactus = (*) <$> tactus a <*> tactus b }
 
 infixl 4 <*, *>, <<*
 applyPatToPat :: (Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)) -> Pattern (a -> b) -> Pattern a -> Pattern b

src/Sound/Tidal/Time.hs

@@ -1,19 +1,20 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 module Sound.Tidal.Time where
 
-import Control.Applicative
-import GHC.Generics
-import Control.DeepSeq (NFData)
+import           Control.Applicative
+import           Control.DeepSeq     (NFData)
+import           Data.Ratio
+import           GHC.Generics
 
 -- | Time is rational
 type Time = Rational
 
 -- | An arc of time, with a start time (or onset) and a stop time (or offset)
 data ArcF a = Arc
   { start :: a
-  , stop :: a
+  , stop  :: a
   } deriving (Eq, Ord, Functor, Show, Generic)
 
 type Arc = ArcF Time
@@ -152,3 +153,7 @@ mapCycle f (Arc s e) = Arc (sam' + f (s - sam')) (sam' + f (e - sam'))
 -- the arc represented by @a@.
 isIn :: Arc -> Time -> Bool
 isIn (Arc s e) t = t >= s && t < e
+
+-- | Returns the lowest common multiple of two rational numbers
+lcmr :: Rational -> Rational -> Rational
+lcmr a b = lcm (numerator a) (numerator b) % gcd (denominator a) (denominator b)

src/Sound/Tidal/UI.hs

@@ -521,7 +521,7 @@ There is also `iter'`, which shifts the pattern in the opposite direction.
 
 -}
 iter :: Pattern Int -> Pattern c -> Pattern c
-iter = tParam _iter
+iter a pat = keepTactus pat $ tParam _iter a pat
 
 _iter :: Int -> Pattern a -> Pattern a
 _iter n p = slowcat $ map (\i -> (fromIntegral i % fromIntegral n) `rotL` p) [0 .. (n-1)]