Earley 0.12.1.0 → 0.13.0.1

raw patch · 8 files changed

Files

• CHANGELOG.md +11/−1
• Earley.cabal +3/−2
• LICENSE +1/−1
• Text/Earley.hs +0/−2
• Text/Earley/Derived.hs +0/−12
• Text/Earley/Grammar.hs +7/−5
• tests/Main.hs +2/−0
• tests/UnbalancedPars.hs +81/−0

@@ -1,8 +1,18 @@ # Unreleased +# 0.13.0.1++- Add a missing test module to the Cabal file++# 0.13.0.0++- Remove the previously deprecated operators `symbol`, `namedSymbol`, and `word`+- Change `Prod`'s `Monoid` and `Semigroup` instances to lift their element instances instead of being the same as the `Alternative` instance+- Add unbalanced parentheses/EOF test+ # 0.12.1.0 -- GHC 8.4.1 support:+- GHC 8.4.1 support - Update 'base' dependency bounds - Add `Semigroup` instance to the `Prod` type 

@@ -1,5 +1,5 @@ name:                Earley-version:             0.12.1.0+version:             0.13.0.1 synopsis:            Parsing all context-free grammars using Earley's algorithm. description:         See <https://www.github.com/ollef/Earley> for more                      information and@@ -9,7 +9,7 @@ license-file:        LICENSE author:              Olle Fredriksson maintainer:          fredriksson.olle@gmail.com-copyright:           (c) 2014-2017 Olle Fredriksson+copyright:           (c) 2014-2019 Olle Fredriksson category:            Parsing build-type:          Simple cabal-version:       >=1.10@@ -146,4 +146,5 @@                        Mixfix,                        Optional,                        ReversedWords,+                       UnbalancedPars,                        VeryAmbiguous

@@ -1,4 +1,4 @@-Copyright (c) 2014-2015, Olle Fredriksson+Copyright (c) 2014-2019, Olle Fredriksson  All rights reserved. 

@@ -4,8 +4,6 @@     Prod, terminal, (<?>), Grammar, rule   , -- * Derived operators     satisfy, token, namedToken, list, listLike-  , -- * Deprecated operators-    symbol, namedSymbol, word   , -- * Parsing     Report(..), Parser.Result(..), Parser, parser, allParses, fullParses   , -- * Recognition

@@ -32,15 +32,3 @@ {-# INLINE listLike #-} listLike :: (Eq t, ListLike i t) => i -> Prod r e t i listLike = ListLike.foldr (liftA2 ListLike.cons . satisfy . (==)) (pure ListLike.empty)--{-# DEPRECATED symbol "Use `token` instead" #-}-symbol :: Eq t => t -> Prod r e t t-symbol = token--{-# DEPRECATED namedSymbol "Use `namedToken` instead" #-}-namedSymbol :: Eq t => t -> Prod r e t t-namedSymbol = token--{-# DEPRECATED word "Use `list` or `listLike` instead" #-}-word :: Eq t => [t] -> Prod r e t [t]-word = list

@@ -64,12 +64,14 @@ (<?>) :: Prod r e t a -> e -> Prod r e t a (<?>) = Named -instance Semigroup (Prod r e t a) where-  (<>) = (<|>)+-- | Lifted instance: @(<>) = 'liftA2' ('<>')@+instance Semigroup a => Semigroup (Prod r e t a) where+  (<>) = liftA2 (Data.Semigroup.<>) -instance Monoid (Prod r e t a) where-  mempty  = empty-  mappend = (<|>)+-- | Lifted instance: @mempty = 'pure' 'mempty'@+instance Monoid a => Monoid (Prod r e t a) where+  mempty  = pure mempty+  mappend = liftA2 mappend  instance Functor (Prod r e t) where   {-# INLINE fmap #-}

@@ -11,6 +11,7 @@ import qualified Mixfix import qualified Optional import qualified ReversedWords+import qualified UnbalancedPars import qualified VeryAmbiguous  main :: IO ()@@ -25,5 +26,6 @@   , Mixfix.tests   , Optional.tests   , ReversedWords.tests+  , UnbalancedPars.tests   , VeryAmbiguous.tests   ]

@@ -0,0 +1,81 @@+{-# LANGUAGE FlexibleContexts, RankNTypes, RecursiveDo, ScopedTypeVariables #-}+module UnbalancedPars where++import Data.Char (isAlpha)++import Control.Applicative+import Test.Tasty+import Test.Tasty.HUnit      as HU++import Text.Earley++tests :: TestTree+tests = testGroup "Unbalanced parentheses"+  [ HU.testCase "Parses balanced" $+      fst (fullParses' unbalancedPars+        "((x))") @?= [(b . b) x]+  , HU.testCase "Parses one unbalanced" $+      fst (fullParses' unbalancedPars+        "((x)") @?= [(u . b) x]+  , HU.testCase "Parses two unbalanced" $+      fst (fullParses' unbalancedPars+        "((x") @?= [(u . u) x]+  ]+  where+    -- [b]alanced+    b :: Expr -> Expr+    b e = ExprInBrackets "(" e ")"++    -- [u]nbalanced+    u :: Expr -> Expr+    u e = ExprInBrackets "(" e ""++    -- [x] variable+    x :: Expr+    x = Var 'x'++data Token = EOF | Char !Char+  deriving (Eq, Ord, Show)++fullParses'+  :: (forall r. Grammar r (Prod r e Token a))+  -> String+  -> ([a], Report e String)+fullParses' g s =+  let (res, rep) = allParses (parser $ (<* eof) <$> g) $ fmap Char s ++ repeat EOF+  in+    ( fst <$> res+    , rep { unconsumed = go $ unconsumed rep }+    )+  where+    go (Char c:xs) = c : go xs+    go _ = []++data Expr =+  Var Char | ExprInBrackets String Expr String+  deriving (Eq, Ord, Show)++eof :: Prod r e Token Token+eof = token EOF++leftPar :: Prod r e Token String+leftPar = "(" <$ token (Char '(')++rightPar :: Prod r e Token String+rightPar = ")" <$ token (Char ')')++var :: Prod r e Token Expr+var = terminal $ \t -> case t of+  Char c | isAlpha c -> Just $ Var c+  _ -> Nothing++unbalancedPars :: Grammar r (Prod r String Token Expr)+unbalancedPars = mdo+  expr <- rule $ var <|> exprInBrackets+  exprInBrackets <- rule $+    ExprInBrackets+      <$> leftPar+      <*> expr+      <*> (rightPar <|> ("" <$ eof))+      <?> "parenthesized expression"+  return expr