diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs index 790d59ef..754e8479 100644 --- a/src/Sound/Tidal/ParseBP.hs +++ b/src/Sound/Tidal/ParseBP.hs @@ -41,7 +41,7 @@ import Data.Typeable (Typeable) import GHC.Exts (IsString (..)) import Sound.Tidal.Chords import Sound.Tidal.Core -import Sound.Tidal.Pattern +import Sound.Tidal.Pattern hiding ((*>), (<*)) import Sound.Tidal.UI import Sound.Tidal.Utils (fromRight) import Text.Parsec.Error @@ -222,7 +222,7 @@ parseBP_E s = toE parsed toE (Right tp) = toPat tp parseTPat :: (Parseable a) => String -> Either ParseError (TPat a) -parseTPat = runParser (pSequence parseRest Prelude.<* eof) (0 :: Int) "" +parseTPat = runParser (pEnter parseRest <* eof) (0 :: Int) "" -- | a '-' is a negative sign if followed anything but another dash -- otherwise, it's treated as rest @@ -237,10 +237,10 @@ parseRest = tPatParser ) <|> char '-' - Prelude.*> pure TPat_Silence + *> pure TPat_Silence <|> tPatParser <|> char '~' - Prelude.*> pure TPat_Silence + *> pure TPat_Silence cP :: (Enumerable a, Parseable a) => String -> Pattern a cP s = innerJoin $ parseBP_E <$> _cX_ getS s @@ -353,10 +353,10 @@ lexer :: P.GenTokenParser String u Data.Functor.Identity.Identity lexer = P.makeTokenParser haskellDef braces, brackets, parens, angles :: MyParser a -> MyParser a -braces p = char '{' Prelude.*> p Prelude.<* char '}' -brackets p = char '[' Prelude.*> p Prelude.<* char ']' -parens p = char '(' Prelude.*> p Prelude.<* char ')' -angles p = char '<' Prelude.*> p Prelude.<* char '>' +braces p = char '{' *> p <* char '}' +brackets p = char '[' *> p <* char ']' +parens p = char '(' *> p <* char ')' +angles p = char '<' *> p <* char '>' symbol :: String -> MyParser String symbol = P.symbol lexer @@ -391,6 +391,8 @@ sign = intOrFloat :: MyParser Double intOrFloat = try pFloat <|> pInteger +-- | Try different parsers on a sequence of Tidal patterns +-- 'f' is the sequence so far, 'a' the next upcoming token/non-terminal pSequence :: (Parseable a) => MyParser (TPat a) -> MyParser (TPat a) pSequence f = do spaces @@ -399,26 +401,11 @@ pSequence f = do do a <- pPart f spaces - do - try $ symbol ".." - b <- pPart f - return $ TPat_EnumFromTo a b - <|> try - ( do - lookAhead - ( char '|' - <|> do - pElongate a <|> pRepeat a - char '|' - ) - pChoice f a - ) + pEnumeration f a <|> pElongate a <|> pRepeat a <|> return a - <|> do - symbol "." - return TPat_Foot + <|> pFoot pRand $ resolve_feet s where resolve_feet ps @@ -435,17 +422,14 @@ pSequence f = do takeFoot (TPat_Foot : pats'') = ([], pats'') takeFoot (pat : pats'') = first (pat :) $ takeFoot pats'' -pChoice :: (Parseable a) => MyParser (TPat a) -> TPat a -> MyParser (TPat a) -pChoice f a = do - eor <- option (TPat_Seq []) (pElongate a <|> pRepeat a) - cs <- many1 $ - do - char '|' - b <- pPart f - pElongate b <|> pRepeat b <|> return b - seed <- newSeed - rest <- option (TPat_Seq []) (pSequence f) - return $ TPat_Seq [TPat_CycleChoose seed (eor : (a : cs)), rest] +pFoot :: MyParser (TPat a) +pFoot = symbol "." >> return TPat_Foot + +pEnumeration :: (Parseable a) => MyParser (TPat a) -> TPat a -> MyParser (TPat a) +pEnumeration f a = do + try $ symbol ".." + b <- pPart f + return $ TPat_EnumFromTo a b pRepeat :: TPat a -> MyParser (TPat a) pRepeat a = do @@ -483,9 +467,9 @@ newSeed = do Text.Parsec.Prim.modifyState (+ 1) return seed -pPolyIn :: (Parseable a) => MyParser (TPat a) -> MyParser (TPat a) -pPolyIn f = do - x <- brackets $ do +pEnter :: (Parseable a) => MyParser (TPat a) -> MyParser (TPat a) +pEnter f = do + x <- do s <- pSequence f "sequence" stackTail s <|> chooseTail s <|> return s pMult x @@ -500,6 +484,9 @@ pPolyIn f = do seed <- newSeed return $ TPat_CycleChoose seed (s : ss) +pPolyIn :: (Parseable a) => MyParser (TPat a) -> MyParser (TPat a) +pPolyIn f = brackets $ pEnter f + pPolyOut :: (Parseable a) => MyParser (TPat a) -> MyParser (TPat a) pPolyOut f = do @@ -684,6 +671,7 @@ pRand thing = return $ TPat_DegradeBy seed r thing <|> return thing +-- | parse Euclidean notation like 'bd(3,8)' pE :: TPat a -> MyParser (TPat a) pE thing = do diff --git a/test/Sound/Tidal/ParseTest.hs b/test/Sound/Tidal/ParseTest.hs index 92653b8a..6eebef98 100644 --- a/test/Sound/Tidal/ParseTest.hs +++ b/test/Sound/Tidal/ParseTest.hs @@ -339,8 +339,8 @@ run = it "toplevel '|' is the same as in list" $ do compareP (Arc 0 1) - ("[a a|b b b|c c c c]" :: Pattern String) ("a a |b b b|c c c c" :: Pattern String) + ("[a a|b b b|c c c c]" :: Pattern String) it "'|' in list first" $ do evaluate ("1 2@3|4|-|5!6|[7!8 9] 10 . 11 12*2 13!2 . 1@1" :: Pattern String) `shouldNotThrow` anyException @@ -350,5 +350,20 @@ run = it "toplevel '|'" $ do evaluate ("121|23@1|12|[1 321]" :: Pattern String) `shouldNotThrow` anyException + it "list is same as stack" $ do + compareP + (Arc 0 1) + ("1 2, 3 4 5" :: Pattern String) + (stack ["1 2", "3 4 5"]) + it "simple toplevel ',' is the same as in list" $ do + compareP + (Arc 0 1) + ("9!2 1,2 3" :: Pattern String) + (stack ["9!2 1", "2 3"]) + it "toplevel ','. single leading pattern with elongate" $ do + compareP + (Arc 0 1) + ("8@2 4, [23 | 4] , 3 9 8" :: Pattern String) + (stack ["8@2 4", "23|4", "3 9 8"]) where degradeByDefault = _degradeBy 0.5