WIP: top level stack pattern

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

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