From 5358aca4857ce0a680c7e8eef21c3b8153453271 Mon Sep 17 00:00:00 2001 From: sss-create Date: Mon, 10 Feb 2025 19:15:06 +0000 Subject: [PATCH 1/6] automated ormolu reformatting --- src/Sound/Tidal/ParseBP.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs index c41b3754..e4698a1a 100644 --- a/src/Sound/Tidal/ParseBP.hs +++ b/src/Sound/Tidal/ParseBP.hs @@ -454,7 +454,7 @@ pChoice f a = return $ TPat_Seq [TPat_CycleChoose seed (elongOrRep : (a : choices)), rest] -- so far, the first pattern in stack has to be single --- '1 2, 3 4' results in '1 [2, 3 4]' +-- '1 2, 3 4' results in '1 [2, 3 4]' -- also: no elongate or repeat working in first to be stacked (single) pattern pStack :: (Parseable a) => MyParser (TPat a) -> TPat a -> MyParser (TPat a) pStack f a = do From e304fff1acfea0b8b9cc88949690b78e006a16ea Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Mon, 10 Feb 2025 20:15:57 +0100 Subject: [PATCH 2/6] wip: top level stack pattern --- src/Sound/Tidal/ParseBP.hs | 92 ++++++++++++++++++++++------------- test/Sound/Tidal/ParseTest.hs | 20 ++++++++ 2 files changed, 77 insertions(+), 35 deletions(-) diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs index 790d59ef..c41b3754 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 (pSequence 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,13 @@ 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 + <|> pChoice f a <|> pElongate a <|> pRepeat a + <|> pStack f a <|> return a - <|> do - symbol "." - return TPat_Foot + <|> pFoot pRand $ resolve_feet s where resolve_feet ps @@ -435,17 +424,49 @@ pSequence f = do takeFoot (TPat_Foot : pats'') = ([], pats'') takeFoot (pat : pats'') = first (pat :) $ takeFoot pats'' +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 + 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] +pChoice f a = + try $ + lookAhead isChoice >> _pChoice + where + isChoice = + char '|' <|> do + pElongate a <|> pRepeat a + char '|' + _pChoice = do + elongOrRep <- option (TPat_Seq []) (pElongate a <|> pRepeat a) + choices <- many1 $ + do + char '|' + b <- pPart f + pElongate b <|> pRepeat b <|> return b + seed <- newSeed + rest <- pSequence f + return $ TPat_Seq [TPat_CycleChoose seed (elongOrRep : (a : choices)), rest] + +-- so far, the first pattern in stack has to be single +-- '1 2, 3 4' results in '1 [2, 3 4]' +-- also: no elongate or repeat working in first to be stacked (single) pattern +pStack :: (Parseable a) => MyParser (TPat a) -> TPat a -> MyParser (TPat a) +pStack f a = do + try $ do + stacks <- try $ + many1 $ + do + char ',' + spaces + pSequence f + notFollowedBy $ char ')' <|> char ']' <|> char '}' + return $ TPat_Stack (a : stacks) pRepeat :: TPat a -> MyParser (TPat a) pRepeat a = do @@ -684,6 +705,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..50e75500 100644 --- a/test/Sound/Tidal/ParseTest.hs +++ b/test/Sound/Tidal/ParseTest.hs @@ -350,5 +350,25 @@ 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 "toplevel ',' is the same as in list" $ do + compareP + (Arc 0 1) + ("1,2 3" :: Pattern String) + (stack ["1", "2 3"]) + it "toplevel ',' with elongate" $ do + compareP + (Arc 0 1) + ("1!2 8*2,2|3,3 9 8" :: Pattern String) + (stack ["1!2 8*2", "2|3", "3 9 8"]) + it "toplevel ',' more complex pattern" $ do + compareP + (Arc 0 1) + ("7 12,2*3,2!2, 4" :: Pattern String) + ("[7 12,2*3,2!2, 4]" :: Pattern String) where degradeByDefault = _degradeBy 0.5 From 1367b40ccf87c73fb630e8c0ffca2880e46c9c67 Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Mon, 10 Feb 2025 21:48:28 +0100 Subject: [PATCH 3/6] simplified pChoice, support elongate/repeat in pStack --- src/Sound/Tidal/ParseBP.hs | 30 ++++++++++++------------------ test/Sound/Tidal/ParseTest.hs | 13 ++++--------- 2 files changed, 16 insertions(+), 27 deletions(-) diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs index c41b3754..80595294 100644 --- a/src/Sound/Tidal/ParseBP.hs +++ b/src/Sound/Tidal/ParseBP.hs @@ -403,9 +403,9 @@ pSequence f = do spaces pEnumeration f a <|> pChoice f a + <|> pStack f a <|> pElongate a <|> pRepeat a - <|> pStack f a <|> return a <|> pFoot pRand $ resolve_feet s @@ -435,23 +435,16 @@ pEnumeration f a = do pChoice :: (Parseable a) => MyParser (TPat a) -> TPat a -> MyParser (TPat a) pChoice f a = - try $ - lookAhead isChoice >> _pChoice - where - isChoice = - char '|' <|> do - pElongate a <|> pRepeat a + try $ do + elongOrRep <- option (TPat_Seq []) (pElongate a <|> pRepeat a) + choices <- many1 $ + do char '|' - _pChoice = do - elongOrRep <- option (TPat_Seq []) (pElongate a <|> pRepeat a) - choices <- many1 $ - do - char '|' - b <- pPart f - pElongate b <|> pRepeat b <|> return b - seed <- newSeed - rest <- pSequence f - return $ TPat_Seq [TPat_CycleChoose seed (elongOrRep : (a : choices)), rest] + b <- pPart f + pElongate b <|> pRepeat b <|> return b + seed <- newSeed + rest <- pSequence f + return $ TPat_Seq [TPat_CycleChoose seed (elongOrRep : (a : choices)), rest] -- so far, the first pattern in stack has to be single -- '1 2, 3 4' results in '1 [2, 3 4]' @@ -459,6 +452,7 @@ pChoice f a = pStack :: (Parseable a) => MyParser (TPat a) -> TPat a -> MyParser (TPat a) pStack f a = do try $ do + elongOrRep <- option (TPat_Seq []) (pElongate a <|> pRepeat a <|> return a) stacks <- try $ many1 $ do @@ -466,7 +460,7 @@ pStack f a = do spaces pSequence f notFollowedBy $ char ')' <|> char ']' <|> char '}' - return $ TPat_Stack (a : stacks) + return $ TPat_Stack (TPat_Seq [elongOrRep] : stacks) pRepeat :: TPat a -> MyParser (TPat a) pRepeat a = do diff --git a/test/Sound/Tidal/ParseTest.hs b/test/Sound/Tidal/ParseTest.hs index 50e75500..e8b15621 100644 --- a/test/Sound/Tidal/ParseTest.hs +++ b/test/Sound/Tidal/ParseTest.hs @@ -355,20 +355,15 @@ run = (Arc 0 1) ("1 2, 3 4 5" :: Pattern String) (stack ["1 2", "3 4 5"]) - it "toplevel ',' is the same as in list" $ do + it "simple toplevel ',' is the same as in list" $ do compareP (Arc 0 1) ("1,2 3" :: Pattern String) (stack ["1", "2 3"]) - it "toplevel ',' with elongate" $ do + it "toplevel ','. single leading pattern with elongate" $ do compareP (Arc 0 1) - ("1!2 8*2,2|3,3 9 8" :: Pattern String) - (stack ["1!2 8*2", "2|3", "3 9 8"]) - it "toplevel ',' more complex pattern" $ do - compareP - (Arc 0 1) - ("7 12,2*3,2!2, 4" :: Pattern String) - ("[7 12,2*3,2!2, 4]" :: Pattern String) + ("8@2,2|3,3 9 8" :: Pattern String) + (stack ["8@2", "2|3", "3 9 8"]) where degradeByDefault = _degradeBy 0.5 From efc7f8f5036cb03d9abff8c1c1b8e405c755056e Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Mon, 10 Feb 2025 21:55:07 +0100 Subject: [PATCH 4/6] removed comment --- src/Sound/Tidal/ParseBP.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs index eb2d4931..3bb3762f 100644 --- a/src/Sound/Tidal/ParseBP.hs +++ b/src/Sound/Tidal/ParseBP.hs @@ -448,7 +448,6 @@ pChoice f a = -- so far, the first pattern in stack has to be single -- '1 2, 3 4' results in '1 [2, 3 4]' --- also: no elongate or repeat working in first to be stacked (single) pattern pStack :: (Parseable a) => MyParser (TPat a) -> TPat a -> MyParser (TPat a) pStack f a = do try $ do From 7aa1ab6d2af3bcc64f0b74d6c46ba6eb87fdfba6 Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Tue, 11 Feb 2025 23:45:50 +0100 Subject: [PATCH 5/6] top level stack/rand working --- src/Sound/Tidal/ParseBP.hs | 47 +++++++---------------------------- test/Sound/Tidal/ParseTest.hs | 10 ++++---- 2 files changed, 14 insertions(+), 43 deletions(-) diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs index 3bb3762f..5178e8cc 100644 --- a/src/Sound/Tidal/ParseBP.hs +++ b/src/Sound/Tidal/ParseBP.hs @@ -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 <* 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 @@ -236,11 +236,9 @@ parseRest = noneOf "-" tPatParser ) - <|> char '-' - *> pure TPat_Silence + <|> char '-' *> pure TPat_Silence <|> tPatParser - <|> char '~' - *> pure TPat_Silence + <|> char '~' *> pure TPat_Silence cP :: (Enumerable a, Parseable a) => String -> Pattern a cP s = innerJoin $ parseBP_E <$> _cX_ getS s @@ -402,8 +400,6 @@ pSequence f = do a <- pPart f spaces pEnumeration f a - <|> pChoice f a - <|> pStack f a <|> pElongate a <|> pRepeat a <|> return a @@ -433,34 +429,6 @@ pEnumeration f a = do b <- pPart f return $ TPat_EnumFromTo a b -pChoice :: (Parseable a) => MyParser (TPat a) -> TPat a -> MyParser (TPat a) -pChoice f a = - try $ do - elongOrRep <- option (TPat_Seq []) (pElongate a <|> pRepeat a) - choices <- many1 $ - do - char '|' - b <- pPart f - pElongate b <|> pRepeat b <|> return b - seed <- newSeed - rest <- pSequence f - return $ TPat_Seq [TPat_CycleChoose seed (elongOrRep : (a : choices)), rest] - --- so far, the first pattern in stack has to be single --- '1 2, 3 4' results in '1 [2, 3 4]' -pStack :: (Parseable a) => MyParser (TPat a) -> TPat a -> MyParser (TPat a) -pStack f a = do - try $ do - elongOrRep <- option (TPat_Seq []) (pElongate a <|> pRepeat a <|> return a) - stacks <- try $ - many1 $ - do - char ',' - spaces - pSequence f - notFollowedBy $ char ')' <|> char ']' <|> char '}' - return $ TPat_Stack (TPat_Seq [elongOrRep] : stacks) - pRepeat :: TPat a -> MyParser (TPat a) pRepeat a = do es <- many1 $ do @@ -497,9 +465,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 @@ -514,6 +482,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 diff --git a/test/Sound/Tidal/ParseTest.hs b/test/Sound/Tidal/ParseTest.hs index e8b15621..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 @@ -358,12 +358,12 @@ run = it "simple toplevel ',' is the same as in list" $ do compareP (Arc 0 1) - ("1,2 3" :: Pattern String) - (stack ["1", "2 3"]) + ("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,2|3,3 9 8" :: Pattern String) - (stack ["8@2", "2|3", "3 9 8"]) + ("8@2 4, [23 | 4] , 3 9 8" :: Pattern String) + (stack ["8@2 4", "23|4", "3 9 8"]) where degradeByDefault = _degradeBy 0.5 From 02324372555b219cc7282f171f9b418abcd2a2c6 Mon Sep 17 00:00:00 2001 From: sss-create Date: Wed, 12 Feb 2025 16:10:52 +0000 Subject: [PATCH 6/6] automated ormolu reformatting --- src/Sound/Tidal/ParseBP.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs index 5178e8cc..754e8479 100644 --- a/src/Sound/Tidal/ParseBP.hs +++ b/src/Sound/Tidal/ParseBP.hs @@ -236,9 +236,11 @@ parseRest = noneOf "-" tPatParser ) - <|> char '-' *> pure TPat_Silence + <|> char '-' + *> pure TPat_Silence <|> tPatParser - <|> char '~' *> pure TPat_Silence + <|> char '~' + *> pure TPat_Silence cP :: (Enumerable a, Parseable a) => String -> Pattern a cP s = innerJoin $ parseBP_E <$> _cX_ getS s