packages feed

tidal 1.5.2 → 1.6.0

raw patch · 12 files changed

+228/−49 lines, 12 filesdep ~basedep ~deepseqdep ~hosc

Dependency ranges changed: base, deepseq, hosc

Files

BootTidal.hs view
@@ -14,6 +14,8 @@ let only = (hush >>)     p = streamReplace tidal     hush = streamHush tidal+    panic = do hush+               once $ sound "superpanic"     list = streamList tidal     mute = streamMute tidal     unmute = streamUnmute tidal
CHANGELOG.md view
@@ -1,5 +1,16 @@ # TidalCycles log of changes ++## 1.6.0 - Keep live coding live+	* Rollback to previous pattern on parse error @jwaldmann+	* Increased strictness to catch parse errors earlier @jwaldmann @yaxu+	* Support for superdirt 'panic' @yaxu+	* Increase hosc upper bounds to admin 0.18+	* New function 'splat' @yaxu+	* `quantise` now uses round, add qfloor, qceiling variants and qround alis @lwlsn+	* Add ghc 8.8.3 to travis @jwaldmann+	* Switch `substruct` to use binary pattern @yaxu+ ## 1.5.2 - Rivelin         * Fix streamAll
src/Sound/Tidal/Control.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings, FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings, FlexibleContexts, BangPatterns #-}  module Sound.Tidal.Control where @@ -287,7 +287,7 @@ loopAt n p = slow n p |* P.speed (fromRational <$> (1/n)) # P.unit (pure "c")  hurry :: Pattern Rational -> ControlPattern -> ControlPattern-hurry x = (|* P.speed (fromRational <$> x)) . fast x+hurry !x = (|* P.speed (fromRational <$> x)) . fast x  {- | Smash is a combination of `spread` and `striate` - it cuts the samples into the given number of bits, and then cuts between playing the loop@@ -402,3 +402,6 @@         offset st = fromMaybe (pure 0) $ do p <- Map.lookup ctrl (controls st)                                             return $ ((f . fromMaybe 0 . getR) <$> p)         ctrl = "_t_" ++ show k++splat :: Pattern Int -> ControlPattern -> ControlPattern -> ControlPattern+splat slices epat pat = (chop slices pat) # bite 1 (const 0 <$> pat) epat
src/Sound/Tidal/Core.hs view
@@ -367,8 +367,11 @@ compressTo :: (Time,Time) -> Pattern a -> Pattern a compressTo (s,e) = compressArcTo (Arc s e) -repeatCycles :: Int -> Pattern a -> Pattern a-repeatCycles n p = cat (replicate n p)+repeatCycles :: Pattern Int -> Pattern a -> Pattern a+repeatCycles = tParam _repeatCycles++_repeatCycles :: Int -> Pattern a -> Pattern a+_repeatCycles n p = cat (replicate n p)  fastRepeatCycles :: Int -> Pattern a -> Pattern a fastRepeatCycles n p = cat (replicate n p)
src/Sound/Tidal/Pattern.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TypeSynonymInstances #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Sound.Tidal.Pattern where@@ -9,6 +10,7 @@ import           Control.Applicative (liftA2) --import           Data.Bifunctor (Bifunctor(..)) import           Data.Data (Data) -- toConstr+import           GHC.Generics import           Data.List (delete, findIndex, sort) import qualified Data.Map.Strict as Map import           Data.Maybe (isJust, fromJust, catMaybes, mapMaybe)@@ -42,13 +44,11 @@ data ArcF a = Arc   { start :: a   , stop :: a-  } deriving (Eq, Ord, Functor, Show)+  } deriving (Eq, Ord, Functor, Show, Generic)  type Arc = ArcF Time -instance NFData a => -  NFData (ArcF a) where -    rnf (Arc s e) = rnf s `seq` rnf e+instance NFData a => NFData (ArcF a)  instance Num a => Num (ArcF a) where   negate      = fmap negate@@ -133,10 +133,9 @@ isIn (Arc s e) t = t >= s && t < e  data Context = Context {contextPosition :: [((Int, Int), (Int, Int))]}-  deriving (Eq, Ord)+  deriving (Eq, Ord, Generic) -instance NFData Context where -    rnf (Context c) = rnf c+instance NFData Context  combineContexts :: [Context] -> Context combineContexts = Context . concatMap contextPosition@@ -159,13 +158,11 @@   , whole :: Maybe a   , part :: a   , value :: b-  } deriving (Eq, Ord, Functor)+  } deriving (Eq, Ord, Functor, Generic)  type Event a = EventF (ArcF Time) a -instance (NFData a, NFData b) => -  NFData (EventF a b) where -    rnf (Event c w p v) = rnf c `seq` rnf w `seq` rnf p `seq` rnf v+instance (NFData a, NFData b) => NFData (EventF a b)  {-instance Bifunctor EventF where   bimap f g (Event w p e) = Event (f w) (f p) (g e)@@ -254,6 +251,7 @@  -- | A datatype that's basically a query data Pattern a = Pattern {query :: Query a}+  deriving Generic  data Value = VS { svalue :: String }            | VF { fvalue :: Double }@@ -261,18 +259,12 @@            | VI { ivalue :: Int }            | VB { bvalue :: Bool }            | VX { xvalue :: [Word8] } -- Used for OSC 'blobs'-           deriving (Typeable,Data)+           deriving (Typeable,Data, Generic)  class Valuable a where   toValue :: a -> Value -instance NFData Value where -  rnf (VS s) = rnf s -  rnf (VF f) = rnf f -  rnf (VR r) = rnf r -  rnf (VI i) = rnf i -  rnf (VB b) = rnf b-  rnf (VX xs) = rnf xs+instance NFData Value  instance Valuable String where   toValue = VS@@ -334,9 +326,7 @@ ------------------------------------------------------------------------ -- * Instances -instance NFData a => -  NFData (Pattern a) where -    rnf (Pattern q) = rnf $ \s -> q s+instance NFData a => NFData (Pattern a)  instance Functor Pattern where   -- | apply a function to all the values in a pattern
src/Sound/Tidal/Stream.hs view
@@ -1,11 +1,13 @@ {-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, FlexibleContexts, ScopedTypeVariables, BangPatterns #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# language DeriveGeneric, StandaloneDeriving #-}  module Sound.Tidal.Stream where  import           Control.Applicative ((<|>)) import           Control.Concurrent.MVar import           Control.Concurrent+import           Control.Monad (forM_) import qualified Data.Map.Strict as Map import           Data.Maybe (fromJust, fromMaybe, catMaybes) import qualified Control.Exception as E@@ -275,13 +277,32 @@                                 state = T.State {T.ticks = 0,                                                  T.start = now,                                                  T.nowTimespan = (now, now + (1/cps)),+                                                 T.starting = True, -- really?                                                  T.nowArc = (Arc 0 1)                                                 }                             doTick True (stream {sPMapMV = pMapMV}) state +-- | Query the current pattern (contained in argument @stream :: Stream@)+-- for the events in the current arc (contained in argument @st :: T.State@),+-- translate them to OSC messages, and send these.+--+-- If an exception occurs during sending,+-- this functions prints a warning and continues, because+-- the likely reason is that the backend (supercollider) isn't running.+-- +-- If any exception occurs before or outside sending+-- (e.g., while querying the pattern, while computing a message),+-- this function prints a warning and resets the current pattern+-- to the previous one (or to silence if there isn't one) and continues,+-- because the likely reason is that something is wrong with the current pattern. doTick :: Bool -> Stream -> T.State -> IO () doTick fake stream st =-  do tempo <- takeMVar (sTempoMV stream)+  E.handle (\ (e :: E.SomeException) -> do+    putStrLn $ "Failed to Stream.doTick: " ++ show e+    putStrLn $ "Return to previous pattern."+    setPreviousPatternOrSilence stream+           ) $+  modifyMVar_ (sTempoMV stream) $ \ tempo -> do      pMap <- readMVar (sPMapMV stream)      sMap <- readMVar (sInput stream)      sGlobalF <- readMVar (sGlobalFMV stream)@@ -308,22 +329,27 @@          -- TODO onset is calculated in toOSC as well..          on e tempo'' = (sched tempo'' $ start $ wholeOrPart e)          (tes, tempo') = processCps tempo es-     mapM_ (\cx@(Cx target _ oscs) ->-              (do let latency = oLatency target + extraLatency-                      ms = concatMap (\(t, e) ->-                                        if (fake || (on e t) < frameEnd)-                                        then catMaybes $ map (toOSC latency e t) oscs-                                        else []-                                     ) tes-                  E.catch $ mapM_ (send cx) ms-              )-              (\(e ::E.SomeException)-                -> putStrLn $ "Failed to send. Is the '" ++ oName target ++ "' target running? " ++ show e-              )-           ) cxs-     putMVar (sTempoMV stream) tempo'-     return ()+     forM_ cxs $ \cx@(Cx target _ oscs) -> do+         let latency = oLatency target + extraLatency+             ms = concatMap (\(t, e) ->+                              if (fake || (on e t) < frameEnd)+                              then catMaybes $ map (toOSC latency e t) oscs+                              else []+                          ) tes+         forM_ ms $ \ m -> send cx m `E.catch` \ (e :: E.SomeException) -> do+           putStrLn $ "Failed to send. Is the '" ++ oName target ++ "' target running? " ++ show e +     tempo' `seq` return tempo'+++setPreviousPatternOrSilence :: Stream -> IO ()+setPreviousPatternOrSilence stream =+  modifyMVar_ (sPMapMV stream) $ return+    . Map.map ( \ pMap -> case history pMap of+      _:p:ps -> pMap { pattern = p, history = p:ps }+      _ -> pMap { pattern = silence, history = [silence] }+              )+       send :: Cx -> (Double, O.Message) -> IO () send cx (time, m)   | oSchedule target == Pre BundleStamp = O.sendBundle u $ O.Bundle time [m]
src/Sound/Tidal/UI.hs view
@@ -988,10 +988,11 @@ struct ps pv = filterJust $ (\a b -> if a then Just b else Nothing ) <$> ps <* pv  -- | @substruct a b@: similar to @struct@, but each event in pattern @a@ gets replaced with pattern @b@, compressed to fit the timespan of the event.-substruct :: Pattern String -> Pattern b -> Pattern b++substruct :: Pattern Bool -> Pattern b -> Pattern b substruct s p = p {query = f}   where f st =-          concatMap ((\a' -> queryArc (compressArcTo a' p) a') . fromJust . whole) $ filter isDigital $ (query s st)+          concatMap ((\a' -> queryArc (compressArcTo a' p) a') . wholeOrPart) $ filter value $ query s st  randArcs :: Int -> Pattern [Arc] randArcs n =@@ -1007,6 +1008,7 @@              pairUp' [a, _] = [Arc a 1]              pairUp' (a:b:xs) = Arc a b: pairUp' (b:xs) + -- TODO - what does this do? Something for @stripe@ .. randStruct :: Int -> Pattern Int randStruct n = splitQueries $ Pattern {query = f}@@ -1274,7 +1276,7 @@  {- | Internal function used by shuffle and scramble -} _rearrangeWith :: Pattern Int -> Int -> Pattern a -> Pattern a-_rearrangeWith ipat n pat = innerJoin $ (\i -> _fast nT $ repeatCycles n $ pats !! i) <$> ipat+_rearrangeWith ipat n pat = innerJoin $ (\i -> _fast nT $ _repeatCycles n $ pats !! i) <$> ipat   where     pats = map (\i -> zoom (fromIntegral i / nT, fromIntegral (i+1) / nT) pat) [0 .. (n-1)]     nT :: Time@@ -1315,6 +1317,7 @@                 toEv (a',v) = do a'' <- subArc a a'                                  return $ Event (Context []) (Just a') a'' v + ur :: Time -> Pattern String -> [(String, Pattern a)] -> [(String, Pattern a -> Pattern a)] -> Pattern a ur t outer_p ps fs = _slow t $ unwrap $ adjust <$> timedValues (getPat . split <$> outer_p)   where split = wordsBy (==':')@@ -1754,7 +1757,17 @@ -- | limit values in a Pattern (or other Functor) to n equally spaced -- divisions of 1. quantise :: (Functor f, RealFrac b) => b -> f b -> f b-quantise n = fmap ((/n) . (fromIntegral :: RealFrac b => Int -> b) . floor . (*n))+quantise n = fmap ((/n) . (fromIntegral :: RealFrac b => Int -> b) . round . (*n))++-- quantise but with floor+qfloor :: (Functor f, RealFrac b) => b -> f b -> f b+qfloor n = fmap ((/n) . (fromIntegral :: RealFrac b => Int -> b) . floor . (*n))++qceiling :: (Functor f, RealFrac b) => b -> f b -> f b+qceiling n = fmap ((/n) . (fromIntegral :: RealFrac b => Int -> b) . ceiling . (*n))++qround :: (Functor f, RealFrac b) => b -> f b -> f b+qround = quantise  -- | Inverts all the values in a boolean pattern inv :: Functor f => f Bool -> f Bool
src/Sound/Tidal/Version.hs view
@@ -1,4 +1,4 @@ module Sound.Tidal.Version where  tidal_version :: String-tidal_version = "1.5.2"+tidal_version = "1.6.0"
+ test/Sound/Tidal/ExceptionsTest.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedStrings, CPP #-}++module Sound.Tidal.ExceptionsTest where++import TestUtils+import Test.Microspec+import Control.Exception+import Control.DeepSeq+import Data.Typeable (typeOf)+import Prelude hiding ((<*), (*>))++import qualified Data.Map.Strict as Map++-- import Sound.Tidal.Pattern+import Sound.Tidal.Control+import Sound.Tidal.Core+import Sound.Tidal.Params+import Sound.Tidal.ParseBP+import Sound.Tidal.Pattern+import Sound.Tidal.UI++run :: Microspec ()+run =+  describe "NFData, forcing and catching exceptions" $ do+    describe "instance NFData (Pattern a)" $ do+      it "rnf forces argument" $ do+        evaluate (rnf (Pattern undefined :: Pattern ()))+          `shouldThrow` anyException+++-- copied from http://hackage.haskell.org/package/hspec-expectations-0.8.2/docs/src/Test-Hspec-Expectations.html#shouldThrow++shouldThrow :: (Exception e) => IO a -> Selector e -> Microspec ()+action `shouldThrow` p = prop "shouldThrow" $ monadicIO $ do+  r <- Test.Microspec.run $ try action+  case r of+    Right _ ->+      -- "finished normally, but should throw exception: " ++ exceptionType+      Test.Microspec.assert False+    Left e ->+      -- "threw exception that did not meet expectation")+      Test.Microspec.assert $ p e+  where+    -- a string repsentation of the expected exception's type+    exceptionType = (show . typeOf . instanceOf) p+      where+        instanceOf :: Selector a -> a+        instanceOf _ = error "Test.Hspec.Expectations.shouldThrow: broken Typeable instance"++-- |+-- A @Selector@ is a predicate; it can simultaneously constrain the type and+-- value of an exception.++type Selector a = (a -> Bool)++anyException :: Selector SomeException+anyException = const True++anyErrorCall :: Selector ErrorCall+anyErrorCall = const True++errorCall :: String -> Selector ErrorCall+#if MIN_VERSION_base(4,9,0)+errorCall s (ErrorCallWithLocation msg _) = s == msg+#else+errorCall s (ErrorCall msg) = s == msg+#endif++anyIOException :: Selector IOException+anyIOException = const True++anyArithException :: Selector ArithException+anyArithException = const True
test/Test.hs view
@@ -9,6 +9,7 @@ import Sound.Tidal.ScalesTest import Sound.Tidal.UITest import Sound.Tidal.UtilsTest+import Sound.Tidal.ExceptionsTest  main :: IO () main = microspec $ do@@ -19,3 +20,4 @@   Sound.Tidal.ScalesTest.run   Sound.Tidal.UITest.run   Sound.Tidal.UtilsTest.run+  Sound.Tidal.ExceptionsTest.run
+ test/dontcrash.hs view
@@ -0,0 +1,46 @@+-- | test cases collected from some "Crash bugs"++{-# language OverloadedStrings #-}++import Control.Concurrent (threadDelay)+import Control.Monad (forM_)++import Sound.Tidal.Context+++main = do+  tidal <- startTidal (superdirtTarget {oLatency = 0.1, oAddress = "127.0.0.1", oPort = 57120}) (defaultConfig {cFrameTimespan = 1/20})+  let p = streamReplace tidal+      d1 = p 1 . (|< orbit 0)++  -- This will execute patterns-that-crash-tidal one after another,+  -- interspersed with a simple pattern.+  -- The test is whether we hear that simple pattern each time,+  -- indicating that the Tidal main loop is still usable.+  let go ps = forM_ (zip [0::Int ..] ps) $ \ (k,p) -> do+        let wait s = threadDelay $ s * 10^6+            simple = s "[bd*4, 808cy*8]"+        putStrLn $ "--- playing test pattern " ++ show k ++ " -----"+        d1 $ p      ; wait 2+        putStrLn $ "---------------- playing simple pattern"+        d1 $ simple ; wait 2++  go [ "cr"++       -- https://github.com/tidalcycles/Tidal/issues/606#issue-563234396+     , gain (unwrap $ fmap (["1", "0."]!!) $ "{0 0@7 0 1@7}%16") # s "harmor" # midichan 11++       -- https://github.com/tidalcycles/Tidal/issues/606#issuecomment-598776256+     , superimpose (hurry "<0.5 2?") $ sound "bd"++       -- https://github.com/tidalcycles/Tidal/issues/477#issue-411754641+     , let mkpat name pattern = (name,pattern)+           mkfx name fx = (name,fx)+           structure = cat [+             "kicks@8 [kicks,snares]@7 kicks:backrush"+             ,    "[kicks@3 [kicks@3 kicks(3,8,1):r]]@4 [kicks]@4 [kicks]@7 kicks:r"+             ]+           pats = [ mkpat "kicks" $ sometimes ghost $ s "bd(<4 5 3 6>,16,<0 1 0 3>)" ]+           fx = [ mkfx "r" (# speed "-1") ]+       in ur 16 structure pats fx+     ]
tidal.cabal view
@@ -1,5 +1,5 @@ name:                tidal-version:             1.5.2+version:             1.6.0 synopsis:            Pattern language for improvised music -- description: homepage:            http://tidalcycles.org/@@ -52,7 +52,7 @@       base >=4.8 && <5     , containers < 0.7     , colour < 2.4-    , hosc >= 0.17 && < 0.18+    , hosc >= 0.17 && < 0.19     , text < 1.3     , parsec >= 3.1.12 && < 3.2     , network < 3.2@@ -83,6 +83,7 @@                  Sound.Tidal.ScalesTest                  Sound.Tidal.UITest                  Sound.Tidal.UtilsTest+                 Sound.Tidal.ExceptionsTest                  TestUtils   build-depends:                 base ==4.*@@ -90,8 +91,17 @@               , containers               , parsec               , tidal+              , deepseq    default-language: Haskell2010++-- not useful for automation since it requires running sclang+test-suite dontcrash+  type: exitcode-stdio-1.0+  main-is: dontcrash.hs+  hs-source-dirs: test+  build-depends: base, tidal+  default-language:    Haskell2010  benchmark bench-speed   type:             exitcode-stdio-1.0