From 97f180b6b24b5d7f9861c1ecab9e8e1a58be3b64 Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Thu, 23 Jan 2025 00:54:04 +0100 Subject: [PATCH 1/5] resolve dash as rest issues --- src/Sound/Tidal/ParseBP.hs | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs index e69fa669..6a3a16cd 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 @@ -221,10 +221,20 @@ parseBP_E s = toE parsed toE (Right tp) = toPat tp parseTPat :: Parseable a => String -> Either ParseError (TPat a) -parseTPat = runParser (pSequence f' Prelude.<* eof) (0 :: Int) "" - where f' = do tPatParser - <|> do oneOf "~-" "rest" - return TPat_Silence +parseTPat = runParser (pSequence parseRest <* eof) (0 :: Int) "" + +-- | a '-' is a negative sign if followed by a digit. +-- otherwise, it's treated as rest +parseRest :: Parseable a => MyParser (TPat a) +parseRest = + try (do + lookAhead $ do + char '-' + digit + tPatParser) + <|> char '-' *> pure TPat_Silence + <|> tPatParser + <|> char '~' *> pure TPat_Silence cP :: (Enumerable a, Parseable a) => String -> Pattern a cP s = innerJoin $ parseBP_E <$> _cX_ getS s @@ -334,11 +344,12 @@ instance (Enumerable a, Parseable a) => IsString (Pattern a) where lexer :: P.GenTokenParser String u Data.Functor.Identity.Identity lexer = P.makeTokenParser haskellDef + braces, brackets, parens, angles:: MyParser a -> MyParser a braces = P.braces lexer -brackets = P.brackets lexer +brackets p = char '[' *> p <* char ']' parens = P.parens lexer -angles = P.angles lexer +angles p = char '<' *> p <* char '>' symbol :: String -> MyParser String symbol = P.symbol lexer From 2cef8262cdaed8b6113233d144c424f7c7ebdb83 Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Thu, 23 Jan 2025 08:31:10 +0100 Subject: [PATCH 2/5] refined 'dash followed by not a dash' case --- src/Sound/Tidal/ParseBP.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs index 6a3a16cd..4cfd1ead 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 hiding ((*>), (<*)) +import Sound.Tidal.Pattern import Sound.Tidal.UI import Sound.Tidal.Utils (fromRight) import Text.Parsec.Error @@ -221,20 +221,21 @@ 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 (pSequence parseRest Prelude.<* eof) (0 :: Int) "" --- | a '-' is a negative sign if followed by a digit. +-- | a '-' is a negative sign if followed anything but another dash -- otherwise, it's treated as rest parseRest :: Parseable a => MyParser (TPat a) parseRest = try (do lookAhead $ do char '-' - digit + spaces + noneOf "-" tPatParser) - <|> char '-' *> pure TPat_Silence + <|> char '-' Prelude.*> pure TPat_Silence <|> tPatParser - <|> char '~' *> pure TPat_Silence + <|> char '~' Prelude.*> pure TPat_Silence cP :: (Enumerable a, Parseable a) => String -> Pattern a cP s = innerJoin $ parseBP_E <$> _cX_ getS s @@ -346,10 +347,10 @@ lexer = P.makeTokenParser haskellDef braces, brackets, parens, angles:: MyParser a -> MyParser a -braces = P.braces lexer -brackets p = char '[' *> p <* char ']' -parens = P.parens lexer -angles p = char '<' *> p <* char '>' +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 '>' symbol :: String -> MyParser String symbol = P.symbol lexer From c1e3c4aff9838596f4419be58e769b39db5912f6 Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Thu, 23 Jan 2025 11:38:10 +0100 Subject: [PATCH 3/5] added tests --- src/Sound/Tidal/ParseBP.hs | 1 - test/Sound/Tidal/ParseTest.hs | 20 ++++++++++++++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs index 4cfd1ead..4ff392da 100644 --- a/src/Sound/Tidal/ParseBP.hs +++ b/src/Sound/Tidal/ParseBP.hs @@ -345,7 +345,6 @@ instance (Enumerable a, Parseable a) => IsString (Pattern a) where 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 ']' diff --git a/test/Sound/Tidal/ParseTest.hs b/test/Sound/Tidal/ParseTest.hs index 5448f37c..3e2e73fe 100644 --- a/test/Sound/Tidal/ParseTest.hs +++ b/test/Sound/Tidal/ParseTest.hs @@ -251,4 +251,24 @@ run = compareP (Arc 0 1) ("t*2t t" :: Pattern Bool) ("1*2%3 1" :: Pattern Bool) + it "does the same for '-' and '~' in simple patterns" $ do + compareP (Arc 0 1) + ("- 2" :: Pattern String) + ("~ 2" :: Pattern String) + it "does the same for '-' and '~' in complex patterns" $ do + compareP (Arc 0 1) + ("[-- 2 <-- 2@7 3> 3%4 9|8 -- [-- <2 9q> -]] 2!4" :: Pattern String) + ("[~~ 2 <~~ 2@7 3> 3%4 9|8 ~~ [~~ <2 9q> ~]] 2!4" :: Pattern String) + it "does the same for '-' and '~' using rational numbers" $ do + compareP (Arc 0 1) + ("- 2q -3.999-9" :: Pattern String) + ("~ 2q -3.999-9" :: Pattern String) + it "does the same for '-' and '~' in list patterns" $ do + compareP (Arc 0 1) + ("[-- 2 -- -]" :: Pattern String) + ("[~~ 2 ~~ ~]" :: Pattern String) + it "does the same for '-' and '~' alternating patterns" $ do + compareP (Arc 0 1) + ("<-- 2 -- ->" :: Pattern String) + ("<~~ 2 ~~ ~>" :: Pattern String) where degradeByDefault = _degradeBy 0.5 From 74a4b011db5ddf3a4c1d7d4cbc3175b984289bf5 Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Thu, 23 Jan 2025 11:59:10 +0100 Subject: [PATCH 4/5] test refinement --- test/Sound/Tidal/ParseTest.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/Sound/Tidal/ParseTest.hs b/test/Sound/Tidal/ParseTest.hs index 3e2e73fe..b5c63e07 100644 --- a/test/Sound/Tidal/ParseTest.hs +++ b/test/Sound/Tidal/ParseTest.hs @@ -257,8 +257,8 @@ run = ("~ 2" :: Pattern String) it "does the same for '-' and '~' in complex patterns" $ do compareP (Arc 0 1) - ("[-- 2 <-- 2@7 3> 3%4 9|8 -- [-- <2 9q> -]] 2!4" :: Pattern String) - ("[~~ 2 <~~ 2@7 3> 3%4 9|8 ~~ [~~ <2 9q> ~]] 2!4" :: Pattern String) + ("[-- 2 <-- 2@7 3> 1*4%2 3? 4 9|8 -- [-- <2 9q> -]] 2!4" :: Pattern String) + ("[~~ 2 <~~ 2@7 3> 1*4%2 3? 4 9|8 ~~ [~~ <2 9q> ~]] 2!4" :: Pattern String) it "does the same for '-' and '~' using rational numbers" $ do compareP (Arc 0 1) ("- 2q -3.999-9" :: Pattern String) @@ -269,6 +269,6 @@ run = ("[~~ 2 ~~ ~]" :: Pattern String) it "does the same for '-' and '~' alternating patterns" $ do compareP (Arc 0 1) - ("<-- 2 -- ->" :: Pattern String) - ("<~~ 2 ~~ ~>" :: Pattern String) + ("<-- 2 -- - 8>" :: Pattern String) + ("<~~ 2 ~~ ~ 8>" :: Pattern String) where degradeByDefault = _degradeBy 0.5 From f378a150fdbddf42f40b533d6658209161449aef Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Thu, 23 Jan 2025 22:32:54 +0100 Subject: [PATCH 5/5] + pattern rational test --- test/Sound/Tidal/ParseTest.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/Sound/Tidal/ParseTest.hs b/test/Sound/Tidal/ParseTest.hs index b5c63e07..2d1f62e7 100644 --- a/test/Sound/Tidal/ParseTest.hs +++ b/test/Sound/Tidal/ParseTest.hs @@ -255,6 +255,10 @@ run = compareP (Arc 0 1) ("- 2" :: Pattern String) ("~ 2" :: Pattern String) + it "does the same for '-' and '~' in complex patterns parsed as Rational" $ do + compareP (Arc 0 1) + ("[-- 2 <-- 2@7 3> 4%2 3? 4 9|8 -- [-- <2 9q> -]] 2!4" :: Pattern Rational) + ("[~~ 2 <~~ 2@7 3> 4%2 3? 4 9|8 ~~ [~~ <2 9q> ~]] 2!4" :: Pattern Rational) it "does the same for '-' and '~' in complex patterns" $ do compareP (Arc 0 1) ("[-- 2 <-- 2@7 3> 1*4%2 3? 4 9|8 -- [-- <2 9q> -]] 2!4" :: Pattern String)