egison-pattern-src 0.2.0.0 → 0.2.1.0

raw patch · 6 files changed

+54/−18 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• egison-pattern-src.cabal +1/−1
• src/Language/Egison/Parser/Pattern/Prim.hs +20/−4
• src/Language/Egison/Pretty/Pattern/External.hs +16/−13
• test/Language/Egison/Parser/PatternSpec.hs +6/−0
• test/Language/Egison/Pretty/PatternSpec.hs +6/−0

@@ -1,3 +1,8 @@+## 0.2.1.0++- Fix use of external parsers to delimit input with `,`, `)`, or `]`+- Enable to parse value expression in the form of `#[1, 2, 3]` without parentheses+ ## 0.2.0.0  Breaking changes:

@@ -1,6 +1,6 @@ cabal-version:      2.0 name:               egison-pattern-src-version:            0.2.0.0+version:            0.2.1.0 synopsis:   Manipulating Egison patterns: abstract syntax, parser, and pretty-printer 

@@ -72,8 +72,11 @@ import qualified Language.Egison.Parser.Pattern.Token                                                as Token                                                 ( isSpace+                                                , comma                                                 , parenLeft                                                 , parenRight+                                                , bracketLeft+                                                , bracketRight                                                 , newline                                                 ) import           Language.Egison.Parser.Pattern.Prim.Location@@ -127,17 +130,30 @@  -- | Parse a lexical chunk. takeChunk :: forall n v e s . Source s => Parse n v e s (Tokens s)-takeChunk = withParens <|> withoutParens+takeChunk = withParens <|> withBrackets <|> withoutParens  where   withParens = do     left <- Parsec.single Token.parenLeft     ck   <- Parsec.takeWhileP (Just "lexical chunk (in parens)")-                              endOfChunkInParens+                              (/= Token.parenRight)     right <- Parsec.single Token.parenRight     pure $ consTokens @s left (snocTokens @s ck right)+  withBrackets = do+    left <- Parsec.single Token.bracketLeft+    ck   <- Parsec.takeWhileP (Just "lexical chunk (in brackets)")+                              (/= Token.bracketRight)+    right <- Parsec.single Token.bracketRight+    pure $ consTokens @s left (snocTokens @s ck right)   withoutParens = Parsec.takeWhileP (Just "lexical chunk") endOfChunk-  endOfChunkInParens x = x /= Token.parenRight-  endOfChunk x = not (Token.isSpace x) && x /= Token.parenRight+  endOfChunk x = not (isDelimiter x) && x /= Token.parenRight+  isDelimiter x =+    Token.isSpace x+      || Token.comma+      == x+      || Token.parenRight+      == x+      || Token.bracketRight+      == x  -- | Apply an external parser. extParser :: Source s => ExtParser s a -> Parse n v e s a

@@ -32,32 +32,35 @@                                                 ( PrintMode(..) )  --- | Check whether the string is surrounded by parentheses.+-- | Check whether the string is surrounded by something. ----- >>> surroundedByParens "(Hello, World)"+-- >>> let parens = ('(', ')')+-- >>> surroundedBy parens "(Hello, World)" -- True ----- >>> surroundedByParens "Hello, World"+-- >>> surroundedBy parens "Hello, World" -- False ----- >>> surroundedByParens "(Hello)(World)"+-- >>> surroundedBy parens "(Hello)(World)" -- False-surroundedByParens :: String -> Bool-surroundedByParens ('(' : (reverse -> (')' : body))) = foldr go 0 body == 0+surroundedBy :: (Char, Char) -> String -> Bool+surroundedBy (begin, end) (h : (reverse -> (l : body)))+  | h == begin && l == end = foldr go 0 body == 0  where   go :: Char -> Int -> Int-  go '(' = (+) 1-  go ')' = (-) 1-  go _   = id-surroundedByParens _ = False+  go c | c == begin = (+) 1+       | c == end   = (-) 1+       | otherwise  = id+surroundedBy _ _ = False  lexicalChunk :: Text -> Doc lexicalChunk txt-  | containSpace str && not (surroundedByParens str) = parens $ text txt+  | containsDelimiter str && not (checkSurrounding str) = parens $ text txt   | otherwise = text txt  where-  containSpace = elem ' '-  str          = unpack txt+  containsDelimiter x = elem ' ' x || elem ',' x || elem ')' x || elem ']' x+  checkSurrounding x = surroundedBy ('(', ')') x || surroundedBy ('[', ']') x+  str = unpack txt  varName :: v -> Print n v e Doc varName v = do

@@ -89,6 +89,12 @@     "!ctor _ _"     (Not (Pattern (Name "ctor") [Wildcard, Wildcard]))   , testCase "nested not patterns" $ assertParseExpr "!!_" (Not (Not Wildcard))+  , testCase "tuple pattern that contains value pattern" $ assertParseExpr+    "(#1, #2)"+    (Tuple [Value (ValueExprInt 1), Value (ValueExprInt 2)])+  , testCase "collection pattern that contains value pattern" $ assertParseExpr+    "[#1, #2]"+    (Collection [Value (ValueExprInt 1), Value (ValueExprInt 2)])   ]  test_primitive_pattern_operators :: [TestTree]

@@ -59,6 +59,12 @@     (Not (Pattern (Name "ctor") [Wildcard, Wildcard]))     "!(ctor _ _)"   , testCase "nested not patterns" $ assertPrintExpr (Not (Not Wildcard)) "!!_"+  , testCase "tuple pattern that contains value pattern" $ assertPrintExpr+    (Tuple [Value (ValueExprInt 1), Value (ValueExprInt 2)])+    "(#1, #2)"+  , testCase "collection pattern that contains value pattern" $ assertPrintExpr+    (Collection [Value (ValueExprInt 1), Value (ValueExprInt 2)])+    "[#1, #2]"   ]  test_primitive_pattern_operators :: [TestTree]