Stepwise functions continued

bench/Memory/Tidal/UIB.hs

@@ -14,6 +14,6 @@ euclidB :: Weigh ()
 euclidB =
   wgroup "euclid" $ do
     columns
-    func "euclid" (euclid (head ecA1) (head $ drop 1 ecA1)) ecA2
-    func "euclidFull" (euclidFull (head ecA1) (head $ drop 1 ecA1) ecA2) ecA2
+    func "euclid" (euclid (head ecA1) (head $ Prelude.drop 1 ecA1)) ecA2
+    func "euclidFull" (euclidFull (head ecA1) (head $ Prelude.drop 1 ecA1) ecA2) ecA2
     func "euclidBool" (_euclidBool 1) 100000

bench/Speed/Tidal/UIB.hs

@@ -19,8 +19,8 @@ euclidB :: [Benchmark]
 euclidB =
   [ bgroup
       "euclid"
-      [ bench "euclid" $ whnf (euclid (head ecA1) (head $ drop 1 ecA1)) ecA2,
-        bench "euclidFull" $ whnf (euclidFull (head ecA1) (head $ drop 1 ecA1) ecA2) ecA2,
+      [ bench "euclid" $ whnf (euclid (head ecA1) (head $ Prelude.drop 1 ecA1)) ecA2,
+        bench "euclidFull" $ whnf (euclidFull (head ecA1) (head $ Prelude.drop 1 ecA1) ecA2) ecA2,
         bench "euclidBool" $ whnf (_euclidBool 1) 100000
       ]
   ]

src/Sound/Tidal/Context.hs

@@ -32,4 +32,4 @@ import Sound.Tidal.Stream as C
 import Sound.Tidal.Transition as C
 import Sound.Tidal.UI as C
 import Sound.Tidal.Version as C
-import Prelude hiding ((*>), (<*))
+import Prelude hiding (all, drop, take, (*>), (<*))

tidal-core/src/Sound/Tidal/Control.hs

@@ -106,7 +106,7 @@ chopArc :: Arc -> Int -> [Arc]
 chopArc (Arc s e) n = map (\i -> Arc (s + (e - s) * (fromIntegral i / fromIntegral n)) (s + (e - s) * (fromIntegral (i + 1) / fromIntegral n))) [0 .. n - 1]
 
 _chop :: Int -> ControlPattern -> ControlPattern
-_chop n pat = keepTactus (withTactus (* toRational n) pat) $ squeezeJoin $ f <$> pat
+_chop n pat = keepSteps (withSteps (* toRational n) pat) $ squeezeJoin $ f <$> pat
   where
     f v = fastcat $ map (pure . rangemap v) slices
     rangemap v (b, e) = Map.union (fromMaybe (makeMap (b, e)) $ merge v (b, e)) v
@@ -143,7 +143,7 @@ striate :: Pattern Int -> ControlPattern -> ControlPattern
 striate = patternify _striate
 
 _striate :: Int -> ControlPattern -> ControlPattern
-_striate n p = keepTactus (withTactus (* toRational n) p) $ fastcat $ map offset [0 .. n - 1]
+_striate n p = keepSteps (withSteps (* toRational n) p) $ fastcat $ map offset [0 .. n - 1]
   where
     offset i = mergePlayRange (fromIntegral i / fromIntegral n, fromIntegral (i + 1) / fromIntegral n) <$> p
 
@@ -175,7 +175,7 @@ striate' :: Pattern Int -> Pattern Double -> ControlPattern -> ControlPattern
 striate' = striateBy
 
 _striateBy :: Int -> Double -> ControlPattern -> ControlPattern
-_striateBy n f p = keepTactus (withTactus (* toRational n) p) $ fastcat $ map (offset . fromIntegral) [0 .. n - 1]
+_striateBy n f p = keepSteps (withSteps (* toRational n) p) $ fastcat $ map (offset . fromIntegral) [0 .. n - 1]
   where
     offset i = mergePlayRange (slot * i, (slot * i) + f) <$> p
     slot = (1 - f) / fromIntegral (n - 1)
@@ -320,7 +320,7 @@ _slice n i p =
 --
 --  > d1 $ fast 4 $ randslice 32 $ sound "bev"
 randslice :: Pattern Int -> ControlPattern -> ControlPattern
-randslice = patternify $ \n p -> keepTactus (withTactus (* (toRational n)) $ p) $ innerJoin $ (\i -> _slice n i p) <$> _irand n
+randslice = patternify $ \n p -> keepSteps (withSteps (* (toRational n)) $ p) $ innerJoin $ (\i -> _slice n i p) <$> _irand n
 
 _splice :: Int -> Pattern Int -> ControlPattern -> Pattern (Map.Map String Value)
 _splice bits ipat pat = withEvent f (slice (pure bits) ipat pat) # P.unit (pure "c")
@@ -338,7 +338,7 @@ _splice bits ipat pat = withEvent f (slice (pure bits) ipat pat) # P.unit (pure
 --
 --  > d1 $ splice 8 "[<0*8 0*2> 3*4 2 4] [4 .. 7]" $ sound "breaks165"
 splice :: Pattern Int -> Pattern Int -> ControlPattern -> Pattern (Map.Map String Value)
-splice bitpat ipat pat = setTactusFrom bitpat $ innerJoin $ (\bits -> _splice bits ipat pat) <$> bitpat
+splice bitpat ipat pat = setStepsFrom bitpat $ innerJoin $ (\bits -> _splice bits ipat pat) <$> bitpat
 
 -- |
 --  @loopAt@ makes a sample fit the given number of cycles. Internally, it

tidal-core/src/Sound/Tidal/Core.hs

@@ -302,8 +302,8 @@ fromMaybes = fastcat . map f
 --  The first parameter to run can be given as a pattern:
 --
 --  > d1 $ n (run "<4 8 4 6>") # sound "amencutup"
-run :: (Enum a, Num a) => Pattern a -> Pattern a
-run = (>>= _run)
+run :: (Enum a, Num a, Real a) => Pattern a -> Pattern a
+run npat = setSteps (Just $ toRational <$> npat) $ npat >>= _run
 
 _run :: (Enum a, Num a) => a -> Pattern a
 _run n = fastFromList [0 .. n - 1]
@@ -378,11 +378,11 @@ fastappend = fastAppend
 --  > d1 $ fastcat [sound "bd*2 sn", sound "jvbass*3", sound "drum*2", sound "ht mt"]
 fastCat :: [Pattern a] -> Pattern a
 fastCat (p : []) = p
-fastCat ps = setTactus t $ _fast (toTime $ length ps) $ cat ps
+fastCat ps = setSteps t $ _fast (toTime $ length ps) $ cat ps
   where
-    t = fastCat <$> (sequence $ map tactus ps)
+    t = fastCat <$> (sequence $ map steps ps)
 
---  where t = fromMaybe (toRational $ length ps) $ ((* (toRational $ length ps)) . foldl1 lcmr) <$> (sequence $ map tactus ps)
+--  where t = fromMaybe (toRational $ length ps) $ ((* (toRational $ length ps)) . foldl1 lcmr) <$> (sequence $ map steps ps)
 
 -- | Alias for @fastCat@
 fastcat :: [Pattern a] -> Pattern a
@@ -403,7 +403,7 @@ fastcat = fastCat
 --  >              ]
 timeCat :: [(Time, Pattern a)] -> Pattern a
 timeCat ((_, p) : []) = p
-timeCat tps = setTactus (Just $ pure total) $ stack $ map (\(s, e, p) -> compressArc (Arc (s / total) (e / total)) p) $ arrange 0 $ filter (\(t, _) -> t > 0) $ tps
+timeCat tps = setSteps (Just $ pure total) $ stack $ map (\(s, e, p) -> compressArc (Arc (s / total) (e / total)) p) $ arrange 0 $ filter (\(t, _) -> t > 0) $ tps
   where
     total = sum $ map fst tps
     arrange :: Time -> [(Time, Pattern a)] -> [(Time, Time, Pattern a)]
@@ -468,14 +468,14 @@ mono p = pattern $ \(State a cm) -> flatten $ query p (State a cm)
 -- >  sound "arpy" +| n "0 .. 15"
 -- > ] # speed "[[1 0.8], [1.5 2]*2]/3"
 stack :: [Pattern a] -> Pattern a
-stack pats = (foldr overlay silence pats) {tactus = t}
+stack pats = (foldr overlay silence pats) {steps = t}
   where
     t
       | length pats == 0 = Nothing
       -- TODO - something cleverer..
-      | otherwise = (mono . stack) <$> (sequence $ map tactus pats)
+      | otherwise = (mono . stack) <$> (sequence $ map steps pats)
 
---          | otherwise = foldl1 lcmr <$> (sequence $ map tactus pats)
+--          | otherwise = foldl1 lcmr <$> (sequence $ map steps pats)
 
 -- ** Manipulating time
 
@@ -538,7 +538,7 @@ zoomArc :: Arc -> Pattern a -> Pattern a
 zoomArc (Arc s e) p
   | s >= e = nothing
   | otherwise =
-      withTactus (* d) $
+      withSteps (* d) $
         splitQueries $
           withResultArc (mapCycle ((/ d) . subtract s)) $
             withQueryArc (mapCycle ((+ s) . (* d))) p

tidal-core/src/Sound/Tidal/ParseBP.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -31,39 +32,80 @@ module Sound.Tidal.ParseBP where
 import Control.Applicative ()
 import qualified Control.Exception as E
 import Data.Bifunctor (first)
-import Data.Colour
-import Data.Colour.Names
+import Data.Colour (Colour)
+import Data.Colour.Names (readColourName)
 import Data.Functor (($>))
 import Data.Functor.Identity (Identity)
 import Data.List (intercalate)
-import Data.Maybe
-import Data.Ratio
+import Data.Maybe (fromMaybe)
+import Data.Ratio ((%))
 import Data.Typeable (Typeable)
 import GHC.Exts (IsString (..))
 import Sound.Tidal.Chords
+  ( Modifier (..),
+    chordTable,
+    chordToPatSeq,
+  )
 import Sound.Tidal.Core
-import Sound.Tidal.Pattern hiding ((*>), (<*))
+  ( cB_,
+    cF_,
+    cI_,
+    cN_,
+    cR_,
+    cS_,
+    fastFromList,
+    stack,
+    timeCat,
+    _cX_,
+  )
+import Sound.Tidal.Pattern
+  ( Context (Context),
+    Note (Note),
+    Pattern,
+    Time,
+    fast,
+    getS,
+    innerJoin,
+    rotL,
+    setContext,
+    silence,
+    slow,
+    unwrap,
+  )
 import Sound.Tidal.UI
+  ( chooseBy,
+    euclidOff,
+    euclidOffBool,
+    rand,
+    segment,
+    _degradeByUsing,
+  )
 import Sound.Tidal.Utils (fromRight)
 import Text.Parsec.Error
+  ( ParseError,
+    errorMessages,
+    errorPos,
+    showErrorMessages,
+  )
 import qualified Text.Parsec.Prim
 import Text.ParserCombinators.Parsec
 import Text.ParserCombinators.Parsec.Language (haskellDef)
 import qualified Text.ParserCombinators.Parsec.Token as P
 
 data TidalParseError = TidalParseError
-  { parsecError :: ParseError,
+  { parsecError :: Text.Parsec.Error.ParseError,
     code :: String
   }
   deriving (Eq, Typeable)
 
 instance E.Exception TidalParseError
 
 instance Show TidalParseError where
+  show :: TidalParseError -> String
   show err = "Syntax error in sequence:\n  \"" ++ code err ++ "\"\n  " ++ pointer ++ "  " ++ message
     where
-      pointer = replicate (sourceColumn $ errorPos perr) ' ' ++ "^"
-      message = showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" $ errorMessages perr
+      pointer = replicate (sourceColumn $ Text.Parsec.Error.errorPos perr) ' ' ++ "^"
+      message = Text.Parsec.Error.showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" $ Text.Parsec.Error.errorMessages perr
       perr = parsecError err
 
 type MyParser = Text.Parsec.Prim.Parsec String Int
@@ -103,7 +145,7 @@ instance (Show a) => Show (TPat a) where
   show (TPat_Repeat r v) = "TPat_Repeat (" ++ show r ++ ") (" ++ show v ++ ")"
   show (TPat_EnumFromTo a b) = "TPat_EnumFromTo (" ++ show a ++ ") (" ++ show b ++ ")"
   show (TPat_Var s) = "TPat_Var " ++ show s
-  show (TPat_Chord g iP nP msP) = "TPat_Chord (" ++ (show $ fmap g iP) ++ ") (" ++ show nP ++ ") (" ++ show msP ++ ")"
+  show (TPat_Chord g iP nP msP) = "TPat_Chord (" ++ show (fmap g iP) ++ ") (" ++ show nP ++ ") (" ++ show msP ++ ")"
 
 instance Functor TPat where
   fmap f (TPat_Atom c v) = TPat_Atom c (f v)
@@ -149,7 +191,7 @@ tShow (TPat_Seq vs) = snd $ steps_seq vs
 tShow TPat_Silence = "silence"
 tShow (TPat_EnumFromTo a b) = "unwrap $ fromTo <$> (" ++ tShow a ++ ") <*> (" ++ tShow b ++ ")"
 tShow (TPat_Var s) = "getControl " ++ s
-tShow (TPat_Chord f n name mods) = "chord (" ++ (tShow $ fmap f n) ++ ") (" ++ tShow name ++ ")" ++ tShowList mods
+tShow (TPat_Chord f n name mods) = "chord (" ++ tShow (fmap f n) ++ ") (" ++ tShow name ++ ")" ++ tShowList mods
 tShow a = "can't happen? " ++ show a
 
 toPat :: (Parseable a, Enumerable a) => TPat a -> Pattern a
@@ -211,7 +253,7 @@ steps_size ((TPat_Elongate r p) : ps) = (r, tShow p) : steps_size ps
 steps_size ((TPat_Repeat n p) : ps) = replicate n (1, tShow p) ++ steps_size ps
 steps_size (p : ps) = (1, tShow p) : steps_size ps
 
-parseBP :: (Enumerable a, Parseable a) => String -> Either ParseError (Pattern a)
+parseBP :: (Enumerable a, Parseable a) => String -> Either Text.Parsec.Error.ParseError (Pattern a)
 parseBP s = toPat <$> parseTPat s
 
 parseBP_E :: (Enumerable a, Parseable a) => String -> Pattern a
@@ -222,7 +264,7 @@ parseBP_E s = toE parsed
     toE (Left e) = E.throw $ TidalParseError {parsecError = e, code = s}
     toE (Right tp) = toPat tp
 
-parseTPat :: (Parseable a) => String -> Either ParseError (TPat a)
+parseTPat :: (Parseable a) => String -> Either Text.Parsec.Error.ParseError (TPat a)
 parseTPat = runParser (pTidal parseRest <* eof) (0 :: Int) ""
 
 -- | a '-' is a negative sign if followed anything but another dash