From b79188b29e2049e9cb43027d03168930d6c0eb60 Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Tue, 28 Jan 2025 11:45:56 +0100 Subject: [PATCH 1/3] toplevel '|' --- src/Sound/Tidal/ParseBP.hs | 19 +++++++++++++++++++ test/Sound/Tidal/ExceptionsTest.hs | 9 ++++++++- test/Sound/Tidal/ParseTest.hs | 11 ++++++++++- 3 files changed, 37 insertions(+), 2 deletions(-) diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs index 9041c714..1a94d0fd 100644 --- a/src/Sound/Tidal/ParseBP.hs +++ b/src/Sound/Tidal/ParseBP.hs @@ -403,6 +403,13 @@ pSequence f = do try $ symbol ".." b <- pPart f return $ TPat_EnumFromTo a b + <|> try (do + lookAhead ( + char '|' + <|> do + pElongate a <|> pRepeat a + char '|') + pChoice f a) <|> pElongate a <|> pRepeat a <|> return a @@ -425,6 +432,18 @@ 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] + pRepeat :: TPat a -> MyParser (TPat a) pRepeat a = do es <- many1 $ do diff --git a/test/Sound/Tidal/ExceptionsTest.hs b/test/Sound/Tidal/ExceptionsTest.hs index 7b609b56..2c81afd7 100644 --- a/test/Sound/Tidal/ExceptionsTest.hs +++ b/test/Sound/Tidal/ExceptionsTest.hs @@ -31,7 +31,14 @@ action `shouldThrow` p = prop "shouldThrow" $ Left e -> -- "threw exception that did not meet expectation") Test.Microspec.assert $ p e - where + +shouldNotThrow :: (Exception e) => IO a -> Selector e -> Microspec () +action `shouldNotThrow` p = prop "shouldNotThrow" $ + monadicIO $ do + r <- Test.Microspec.run $ try action + case r of + Right _ -> Test.Microspec.assert True + Left e -> Test.Microspec.assert $ p e -- a string repsentation of the expected exception's type {- diff --git a/test/Sound/Tidal/ParseTest.hs b/test/Sound/Tidal/ParseTest.hs index 0ec10c71..73759681 100644 --- a/test/Sound/Tidal/ParseTest.hs +++ b/test/Sound/Tidal/ParseTest.hs @@ -4,7 +4,7 @@ module Sound.Tidal.ParseTest where import Control.Exception import Sound.Tidal.Core -import Sound.Tidal.ExceptionsTest (anyException, shouldThrow) +import Sound.Tidal.ExceptionsTest (anyException, shouldThrow, shouldNotThrow) import Sound.Tidal.Pattern import Sound.Tidal.UI (_degradeBy) import Test.Microspec @@ -336,5 +336,14 @@ run = (Arc 0 1) ("<-- 2 -- - 8>" :: Pattern String) ("<~~ 2 ~~ ~ 8>" :: 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 + it "'|' in list last" $ do + evaluate ("12@1|23@1|12|[1 3!21]" :: Pattern String) + `shouldNotThrow` anyException + it "toplevel '|'" $ do + evaluate ("121|23@1|12|[1 321]" :: Pattern String) + `shouldNotThrow` anyException where degradeByDefault = _degradeBy 0.5 From 19f86686982ea65ae44e53438b09b51f33753b9d Mon Sep 17 00:00:00 2001 From: sss-create Date: Tue, 28 Jan 2025 10:45:56 +0000 Subject: [PATCH 2/3] automated ormolu reformatting --- src/Sound/Tidal/ParseBP.hs | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs index 1a94d0fd..790d59ef 100644 --- a/src/Sound/Tidal/ParseBP.hs +++ b/src/Sound/Tidal/ParseBP.hs @@ -403,13 +403,16 @@ pSequence f = do try $ symbol ".." b <- pPart f return $ TPat_EnumFromTo a b - <|> try (do - lookAhead ( - char '|' - <|> do + <|> try + ( do + lookAhead + ( char '|' + <|> do pElongate a <|> pRepeat a - char '|') - pChoice f a) + char '|' + ) + pChoice f a + ) <|> pElongate a <|> pRepeat a <|> return a @@ -432,17 +435,17 @@ 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 +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 + 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] + return $ TPat_Seq [TPat_CycleChoose seed (eor : (a : cs)), rest] pRepeat :: TPat a -> MyParser (TPat a) pRepeat a = do From 41e2ae39ca19be260ebff3bf0d72bfac4dc421b5 Mon Sep 17 00:00:00 2001 From: sss-create <72546851@posteo.jp> Date: Thu, 30 Jan 2025 19:13:23 +0100 Subject: [PATCH 3/3] added '|' comparing test --- test/Sound/Tidal/ParseTest.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/test/Sound/Tidal/ParseTest.hs b/test/Sound/Tidal/ParseTest.hs index 73759681..92653b8a 100644 --- a/test/Sound/Tidal/ParseTest.hs +++ b/test/Sound/Tidal/ParseTest.hs @@ -336,6 +336,11 @@ run = (Arc 0 1) ("<-- 2 -- - 8>" :: Pattern String) ("<~~ 2 ~~ ~ 8>" :: Pattern String) + 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) 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