packages feed

tidal 0.9.2 → 0.9.3

raw patch · 10 files changed

+269/−54 lines, 10 filesdep +tastydep +tasty-hunitdep +tidaldep −applicative-numbersdep ~base

Dependencies added: tasty, tasty-hunit, tidal

Dependencies removed: applicative-numbers

Dependency ranges changed: base

Files

Sound/Tidal/Context.hs view
@@ -7,6 +7,7 @@ import Data.Monoid as C import Sound.Tidal.Parse as C import Sound.Tidal.Pattern as C+import Sound.Tidal.PatternList as C import Sound.Tidal.Stream as C import Sound.Tidal.Dirt as C import Sound.Tidal.Strategies as C
Sound/Tidal/Dirt.hs view
@@ -13,6 +13,7 @@ import Data.Maybe import Data.Fixed import Data.Ratio+import Data.List (elemIndex)  import Sound.Tidal.Stream import Sound.Tidal.OscStream@@ -337,3 +338,7 @@  {- | Copies the @n@ parameter to the @orbit@ parameter, so different sound variants or notes go to different orbits in SuperDirt. -} nToOrbit = copyParam n_p orbit_p++{- | Maps the sample or synth names to different @orbit@s, using indexes from the given list. E.g. @soundToOrbit ["bd", "sn", "cp"] $ sound "bd [cp sn]"@ would cause the bd, sn and cp smamples to be sent to orbit 0, 1, 2 respectively.-}+soundToOrbit :: [String] -> ParamPattern -> ParamPattern+soundToOrbit sounds p = follow s_p orbit_p ((\s -> fromMaybe 0 $ elemIndex s sounds) <$>) p
Sound/Tidal/Params.hs view
@@ -321,6 +321,7 @@ pit2 = pitch2 pit3 = pitch3 por = portamento+rel = release sag = sagogo scl = sclaves scp = sclap
Sound/Tidal/Parse.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase, GADTs #-}  module Sound.Tidal.Parse where @@ -21,27 +21,30 @@ import Sound.Tidal.Time (Arc, Time)  -- | AST representation of patterns-data TPat a-   = TPat_Atom a-   | TPat_Density Time (TPat a)-      -- We keep this distinct from '_density because of divide-by-zero:-   | TPat_Slow Time (TPat a)-   | TPat_Zoom Arc (TPat a)-   | TPat_DegradeBy Double (TPat a)-   | TPat_Silence-   | TPat_Foot-   | TPat_Cat [TPat a]-   | TPat_Overlay (TPat a) (TPat a)-   | TPat_ShiftL Time (TPat a)-   -- | TPat_E Int Int (TPat a)-   | TPat_pE (TPat Int) (TPat Int) (TPat Integer) (TPat a)- deriving (Show)+data TPat a where+   TPat_Atom :: Parseable a => a -> TPat a+   TPat_Density :: Parseable a => Time -> (TPat a) -> (TPat a)+   -- We keep this distinct from '_density because of divide-by-zero:+   TPat_Slow :: Parseable a => Time -> TPat a -> TPat a+   TPat_Zoom :: Parseable a => Arc -> TPat a -> TPat a+   TPat_DegradeBy :: Parseable a => Double -> TPat a -> TPat a+   TPat_Silence :: Parseable a => TPat a+   TPat_Foot :: Parseable a => TPat a+   TPat_Enum :: Parseable a => TPat a+   TPat_EnumFromTo :: Parseable a => TPat a -> TPat a -> TPat a +   TPat_Cat :: Parseable a => [TPat a] -> TPat a+   TPat_Overlay :: Parseable a => TPat a -> TPat a -> TPat a+   TPat_ShiftL :: Parseable a => Time -> TPat a -> TPat a+   -- TPat_E Int Int (TPat a)+   TPat_pE :: Parseable a => TPat Int -> TPat Int -> TPat Integer -> TPat a -> TPat a -instance Monoid (TPat a) where+-- deriving (Show)++instance Parseable a => Monoid (TPat a) where    mempty = TPat_Silence    mappend = TPat_Overlay -toPat :: TPat a -> Pattern a+toPat :: Parseable a => TPat a -> Pattern a toPat = \case    TPat_Atom x -> atom x    TPat_Density t x -> _density t $ toPat x@@ -55,35 +58,60 @@    TPat_pE n k s thing ->       unwrap $ eoff <$> toPat n <*> toPat k <*> toPat s <*> pure (toPat thing)    TPat_Foot -> error "Can't happen, feet (.'s) only used internally.."+   TPat_Enum -> error "Can't happen, enums (..'s) only used internally.."+   TPat_EnumFromTo a b -> unwrap $ fromTo <$> (toPat a) <*> (toPat b)+   -- TPat_EnumFromThenTo a b c -> unwrap $ fromThenTo <$> (toPat a) <*> (toPat b) <*> (toPat c)  p :: Parseable a => String -> Pattern a p = toPat . parseTPat  class Parseable a where   parseTPat :: String -> TPat a+  fromTo :: a -> a -> Pattern a+  fromThenTo :: a -> a -> a -> Pattern a  instance Parseable Double where   parseTPat = parseRhythm pDouble+  fromTo a b = enumFromTo' a b+  fromThenTo a b c = enumFromThenTo' a b c  instance Parseable String where   parseTPat = parseRhythm pVocable+  fromTo a b = listToPat [a,b]+  fromThenTo a b c = listToPat [a,b,c]  instance Parseable Bool where   parseTPat = parseRhythm pBool+  fromTo a b = listToPat [a,b]+  fromThenTo a b c = listToPat [a,b,c]  instance Parseable Int where   parseTPat = parseRhythm pIntegral+  fromTo a b = enumFromTo' a b+  fromThenTo a b c = enumFromThenTo' a b c  instance Parseable Integer where   parseTPat s = parseRhythm pIntegral s+  fromTo a b = enumFromTo' a b+  fromThenTo a b c = enumFromThenTo' a b c  instance Parseable Rational where   parseTPat = parseRhythm pRational+  fromTo a b = enumFromTo' a b+  fromThenTo a b c = enumFromThenTo' a b c -type ColourD = Colour Double+enumFromTo' a b | a > b = listToPat $ reverse $ enumFromTo b a+                | otherwise = listToPat $ enumFromTo a b +enumFromThenTo' a b c | a > c = listToPat $ reverse $ enumFromThenTo c (c + (a-b)) a+                      | otherwise = listToPat $ enumFromThenTo a b c++type ColourD = Colour Double + instance Parseable ColourD where   parseTPat = parseRhythm pColour+  fromTo a b = listToPat [a,b]+  fromThenTo a b c = listToPat [a,b,c]  instance (Parseable a) => IsString (Pattern a) where   fromString = toPat . parseTPat@@ -140,21 +168,35 @@                 )                 (return $ p s) -parseRhythm :: Parser (TPat a) -> String -> TPat a+parseRhythm :: Parseable a => Parser (TPat a) -> String -> TPat a parseRhythm f input = either (const TPat_Silence) id $ parse (pSequence f') "" input   where f' = f              <|> do symbol "~" <?> "rest"                     return TPat_Silence -pSequenceN :: Parser (TPat a) -> GenParser Char () (Int, TPat a)+pSequenceN :: Parseable a => Parser (TPat a) -> GenParser Char () (Int, TPat a) pSequenceN f = do spaces                   -- d <- pDensity-                  ps <- many $ pPart f+                  ps <- many $ do a <- pPart f+                                  do Text.ParserCombinators.Parsec.try $ symbol "-"+                                     b <- pPart f+                                     return [TPat_EnumFromTo (TPat_Cat a) (TPat_Cat b)]+                                    <|> return a                                <|> do symbol "."                                       return [TPat_Foot]                   let ps' = TPat_Cat $ map TPat_Cat $ splitFeet $ concat ps                   return (length ps, ps') +{-+expandEnum :: Parseable t => Maybe (TPat t) -> [TPat t] -> [TPat t]+expandEnum a [] = [a]+expandEnum (Just a) (TPat_Enum:b:ps) = (TPat_EnumFromTo a b) : (expandEnum Nothing ps)+-- ignore ..s in other places+expandEnum a (TPat_Enum:ps) = expandEnum a ps+expandEnum (Just a) (b:ps) = a:(expandEnum b (Just c) ps)+expandEnum Nothing (c:ps) = expandEnum (Just c) ps+-}+ -- could use splitOn here but `TPat a` isn't a member of `EQ`.. splitFeet :: [TPat t] -> [[TPat t]] splitFeet [] = []@@ -164,14 +206,14 @@         takeFoot (TPat_Foot:ps) = ([], ps)         takeFoot (p:ps) = (\(a,b) -> (p:a,b)) $ takeFoot ps -pSequence :: Parser (TPat a) -> GenParser Char () (TPat a)+pSequence :: Parseable a => Parser (TPat a) -> GenParser Char () (TPat a) pSequence f = do (_, p) <- pSequenceN f                  return p -pSingle :: Parser (TPat a) -> Parser (TPat a)+pSingle :: Parseable a => Parser (TPat a) -> Parser (TPat a) pSingle f = f >>= pRand >>= pMult -pPart :: Parser (TPat a) -> Parser [TPat a]+pPart :: Parseable a => Parser (TPat a) -> Parser [TPat a] pPart f = do part <- pSingle f <|> pPolyIn f <|> pPolyOut f              part <- pE part              part <- pRand part@@ -181,12 +223,12 @@              spaces              return $ parts -pPolyIn :: Parser (TPat a) -> Parser (TPat a)+pPolyIn :: Parseable a => Parser (TPat a) -> Parser (TPat a) pPolyIn f = do ps <- brackets (pSequence f `sepBy` symbol ",")                spaces                pMult $ mconcat ps -pPolyOut :: Parser (TPat a) -> Parser (TPat a)+pPolyOut :: Parseable a => Parser (TPat a) -> Parser (TPat a) pPolyOut f = do ps <- braces (pSequenceN f `sepBy` symbol ",")                 spaces                 base <- do char '%'@@ -233,7 +275,7 @@               i <- integer               return $ applySign s $ fromIntegral i -pIntegral :: Integral i => Parser (TPat i)+pIntegral :: Parseable a => Integral a => Parser (TPat a) pIntegral = TPat_Atom <$> parseIntNote  parseNote :: Integral a => Parser a@@ -266,7 +308,7 @@              colour <- readColourName name <?> "known colour"              return $ TPat_Atom colour -pMult :: TPat a -> Parser (TPat a)+pMult :: Parseable a => TPat a -> Parser (TPat a) pMult thing = do char '*'                  spaces                  r <- pRatio@@ -281,13 +323,13 @@   -pRand :: TPat a -> Parser (TPat a)+pRand :: Parseable a => TPat a -> Parser (TPat a) pRand thing = do char '?'                  spaces                  return $ TPat_DegradeBy 0.5 thing               <|> return thing -pE :: TPat a -> Parser (TPat a)+pE :: Parseable a => TPat a -> Parser (TPat a) pE thing = do (n,k,s) <- parens (pair)               pure $ TPat_pE n k s thing             <|> return thing@@ -307,7 +349,7 @@ eoff n k s p = ((s%(fromIntegral k)) `rotL`) (e n k p)    -- TPat_ShiftL (s%(fromIntegral k)) (TPat_E n k p) -pReplicate :: TPat a -> Parser [TPat a]+pReplicate :: Parseable a => TPat a -> Parser [TPat a] pReplicate thing =   do extras <- many $ do char '!'                          -- if a number is given (without a space)slow 2 $ fast@@ -320,7 +362,7 @@      return (thing:concat extras)  -pStretch :: TPat a -> Parser [TPat a]+pStretch :: Parseable a => TPat a -> Parser [TPat a] pStretch thing =   do char '@'      n <- ((read <$> many1 digit) <|> return 1)
Sound/Tidal/Pattern.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, CPP #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-warn-name-shadowing #-}  module Sound.Tidal.Pattern where  import Control.Applicative--- import Data.Monoid+import Data.Monoid import Data.Fixed import Data.List import Data.Maybe@@ -30,13 +30,89 @@ data Pattern a = Pattern {arc :: Arc -> [Event a]}   deriving Typeable -#define INSTANCE_Eq-#define INSTANCE_Ord-#define INSTANCE_Enum+noOv :: String -> a+noOv meth = error $ meth ++ ": No overloading" -#define APPLICATIVE Pattern-#include "ApplicativeNumeric-inc.hs"+instance Eq (Pattern a) where+  (==) = noOv "(==)" +instance Ord a => Ord (Pattern a) where+  min = liftA2 min+  max = liftA2 max++instance Num a => Num (Pattern a) where+  negate      = fmap negate+  (+)         = liftA2 (+)+  (*)         = liftA2 (*)+  fromInteger = pure . fromInteger+  abs         = fmap abs+  signum      = fmap signum++instance Enum a => Enum (Pattern a) where+  succ           = fmap succ+  pred           = fmap pred+  toEnum         = pure . toEnum+  fromEnum       = noOv "fromEnum"+  enumFrom       = noOv "enumFrom"+  enumFromThen   = noOv "enumFromThen"+  enumFromTo     = noOv "enumFromTo"+  enumFromThenTo = noOv "enumFromThenTo"++instance (Num a, Ord a) => Real (Pattern a) where+  toRational = noOv "toRational"++instance (Integral a) => Integral (Pattern a) where+  quot          = liftA2 quot+  rem           = liftA2 rem+  div           = liftA2 div+  mod           = liftA2 mod+  toInteger     = noOv "toInteger"+  x `quotRem` y = (x `quot` y, x `rem` y)+  x `divMod`  y = (x `div`  y, x `mod` y)++instance (Fractional a) => Fractional (Pattern a) where+  recip        = fmap recip+  fromRational = pure . fromRational++instance (Floating a) => Floating (Pattern a) where+  pi    = pure pi+  sqrt  = fmap sqrt+  exp   = fmap exp+  log   = fmap log+  sin   = fmap sin+  cos   = fmap cos+  asin  = fmap asin+  atan  = fmap atan+  acos  = fmap acos+  sinh  = fmap sinh+  cosh  = fmap cosh+  asinh = fmap asinh+  atanh = fmap atanh+  acosh = fmap acosh++instance (RealFrac a) => RealFrac (Pattern a) where+  properFraction = noOv "properFraction"+  truncate       = noOv "truncate"+  round          = noOv "round"+  ceiling        = noOv "ceiling"+  floor          = noOv "floor"++instance (RealFloat a) => RealFloat (Pattern a) where+  floatRadix     = noOv "floatRadix"+  floatDigits    = noOv "floatDigits"+  floatRange     = noOv "floatRange"+  decodeFloat    = noOv "decodeFloat"+  encodeFloat    = ((.).(.)) pure encodeFloat+  exponent       = noOv "exponent"+  significand    = noOv "significand"+  scaleFloat n   = fmap (scaleFloat n)+  isNaN          = noOv "isNaN"+  isInfinite     = noOv "isInfinite"+  isDenormalized = noOv "isDenormalized"+  isNegativeZero = noOv "isNegativeZero"+  isIEEE         = noOv "isIEEE"+  atan2          = liftA2 atan2+ -- | @show (p :: Pattern)@ returns a text string representing the -- event values active during the first cycle of the given pattern. instance (Show a) => Show (Pattern a) where@@ -201,6 +277,9 @@ listToPat :: [a] -> Pattern a listToPat = fastcat . map atom +patToList :: Pattern a -> [a]+patToList p = map (thd') $ sortBy (\a b -> compare (snd' a) (snd' b)) $ filter ((\x -> x >= 0 && x < 1) . fst . snd' ) (arc p (0,1))+ -- | @maybeListToPat@ is similar to @listToPat@, but allows values to -- be optional using the @Maybe@ type, so that @Nothing@ results in -- gaps in the pattern.@@ -235,6 +314,8 @@ fast :: Pattern Time -> Pattern a -> Pattern a fast = temporalParam _density +_fast = _density+ fast' :: Pattern Time -> Pattern a -> Pattern a fast' = temporalParam' _density @@ -342,7 +423,9 @@ -- | @rev p@ returns @p@ with the event positions in each cycle -- reversed (or mirrored). rev :: Pattern a -> Pattern a-rev p = splitQueries $ Pattern $ \a -> mapArcs mirrorArc (arc p (mirrorArc a))+rev p = splitQueries $ Pattern $ \a -> map makeWholeAbsolute $ mapSnds' mirrorArc $ map makeWholeRelative (arc p (mirrorArc a))+  where makeWholeRelative ((s,e), part@(s',e'), v) = ((s'-s, e-e'), part, v)+        makeWholeAbsolute ((s,e), part@(s',e'), v) = ((s'-e,e'+s), part, v)  -- | @palindrome p@ applies @rev@ to @p@ every other cycle, so that -- the pattern alternates between forwards and backwards.@@ -911,11 +994,11 @@ splitQueries :: Pattern a -> Pattern a splitQueries p = Pattern $ \a -> concatMap (arc p) $ arcCycles a -{- | Truncates a pattern so that only a fraction of the pattern is played.-The following example plays only the first three quarters of the pattern:+{- | @trunc@ truncates a pattern so that only a fraction of the pattern is played.+The following example plays only the first quarter of the pattern:  @-d1 $ trunc 0.75 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"+d1 $ trunc 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2" @ -} trunc :: Pattern Time -> Pattern a -> Pattern a@@ -924,6 +1007,18 @@ _trunc :: Time -> Pattern a -> Pattern a _trunc t = compress (0,t) . zoom (0,t) +{- | @linger@ is similar to `trunc` but the truncated part of the pattern loops until the end of the cycle++@+d1 $ linger 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"+@+-}+linger :: Pattern Time -> Pattern a -> Pattern a+linger = temporalParam _linger++_linger :: Time -> Pattern a -> Pattern a+_linger n p = _density (1/n) $ zoom (0,n) p+ {- | Plays a portion of a pattern, specified by a beginning and end arc of time. The new resulting pattern is played over the time period of the original pattern: @@ -1129,12 +1224,13 @@ -- | @discretise n p@: 'samples' the pattern @p@ at a rate of @n@ -- events per cycle. Useful for turning a continuous pattern into a -- discrete one.-discretise :: Pattern Time -> Pattern a -> Pattern a-discretise n p = (density n $ atom (id)) <*> p -discretise' :: Time -> Pattern a -> Pattern a-discretise' n p = (_density n $ atom (id)) <*> p+discretise :: Time -> Pattern a -> Pattern a+discretise n p = (_density n $ atom (id)) <*> p +discretise' = discretise+_discretise = discretise+ -- | @randcat ps@: does a @slowcat@ on the list of patterns @ps@ but -- randomises the order in which they are played. randcat :: [Pattern a] -> Pattern a@@ -1205,7 +1301,7 @@  -- | @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 s p = filterStartInRange $ Pattern $ f+substruct s p = Pattern $ f   where f a = concatMap (\a' -> arc (compressTo a' p) a') $ (map fst' $ arc s a)         compressTo (s,e) p = compress (cyclePos s, e-(sam s)) p
+ Sound/Tidal/PatternList.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedLists, TypeFamilies #-}++module Sound.Tidal.PatternList where++import Sound.Tidal.Pattern+import GHC.Exts( IsList(..) )++instance (Ord a) => IsList (Pattern a) where+  type Item (Pattern a) = a+  fromList = listToPat+  toList   = patToList+
Sound/Tidal/Stream.hs view
@@ -295,7 +295,7 @@ withS :: Param -> (Pattern String -> Pattern String) -> ParamPattern -> ParamPattern withS = with -follow :: ParamType a => Param -> Param -> (Pattern a -> Pattern a) -> ParamPattern -> ParamPattern+follow :: (ParamType a, ParamType b) => Param -> Param -> (Pattern a -> Pattern b) -> ParamPattern -> ParamPattern follow source dest f p = p # (makeP dest $ f (get source p))  -- follow :: ParamType a => Param -> (Pattern a -> ParamPattern) -> ParamPattern -> ParamPattern
Sound/Tidal/Version.hs view
@@ -1,4 +1,4 @@  module Sound.Tidal.Version where -tidal_version = "0.9.1"+tidal_version = "0.9.3"
+ tests/test.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++import Test.Tasty+-- import Test.Tasty.SmallCheck as SC+-- import Test.Tasty.QuickCheck as QC+import Test.Tasty.HUnit++import Data.List+import Data.Ord++import Sound.Tidal.Context++main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [basic1,+                           patternsOfPatterns+                          ]++basic1 = testGroup "fast / slow"+         [+           testCase "silence" $ same16 (fast 1.1 silence) (silence :: Pattern Double),+           testCase "fast" $ same16  silence (silence :: Pattern Double),+           testCase "fast" $ same16 "bd*128" (rep 128 "bd")+         ]++patternsOfPatterns =+  testGroup "patterns of patterns"+  [+    testCase "decimal density" $ same16 (_discretise 0.25 saw) (discretise 0.25 saw)+  ]++rep :: Int -> String -> Pattern String+rep n v = p $ intercalate " " $ take n $ repeat v++sameN :: (Eq a, Show a) => String -> Time -> Pattern a -> Pattern a -> Assertion+sameN s n a b = assertEqual s (arc a (0,n)) (arc b (0,n))++same16 :: (Eq a, Show a) => Pattern a -> Pattern a -> Assertion+same16 = sameN "for 16 cycles," 16+
tidal.cabal view
@@ -1,5 +1,5 @@ name:                tidal-version:             0.9.2+version:             0.9.3 synopsis:            Pattern language for improvised music -- description: homepage:            http://tidalcycles.org/@@ -11,7 +11,7 @@ Copyright:           (c) Tidal contributors, 2017 category:            Sound build-type:          Simple-cabal-version:       >=1.6+cabal-version:       >=1.10 tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1  Extra-source-files: README.md tidal.el doc/tidal.md@@ -19,6 +19,8 @@ Description: Tidal is a domain specific language for live coding pattern.  library+  default-language:    Haskell2010+   Exposed-modules:     Sound.Tidal.Bjorklund                        Sound.Tidal.Strategies                        Sound.Tidal.Dirt@@ -36,6 +38,7 @@                        Sound.Tidal.Scales                        Sound.Tidal.Chords                        Sound.Tidal.Version+                       Sound.Tidal.PatternList    Build-depends:       base < 5@@ -50,8 +53,22 @@     , safe     , websockets > 0.8     , mtl >= 2.1-    , applicative-numbers  source-repository head   type:     git   location: https://github.com/tidalcycles/Tidal++test-suite test+  default-language:+    Haskell2010+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    tests+  main-is:+    test.hs+  build-depends:+      base >= 4 && < 5+              , tasty >= 0.11+              , tasty-hunit+    , tidal