bookhound 0.1.13.0 → 0.1.14.0

raw patch · 6 files changed

+108/−77 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• bookhound.cabal +2/−1
• src/Bookhound/Parser.hs +92/−69
• src/Bookhound/ParserCombinators.hs +2/−2
• src/Bookhound/Parsers/Number.hs +1/−1
• src/Bookhound/Utils/Foldable.hs +7/−2
• src/Bookhound/Utils/Map.hs +4/−2

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           bookhound-version:        0.1.13.0+version:        0.1.14.0 synopsis:       Simple Parser Combinators description:    Please see the README on GitHub at <https://github.com/albertprz/bookhound#readme> category:       Parser Combinators@@ -47,6 +47,7 @@       MultiWayIf       TupleSections       PostfixOperators+      BlockArguments       RankNTypes       ExplicitForAll       ScopedTypeVariables

@@ -1,13 +1,12 @@ module Bookhound.Parser (Parser, ParseResult, ParseError(..), runParser, errorParser,-               andThen, exactly, isMatch, check, except, anyOf, allOf, char,-               withTransform, withError) where+               andThen, exactly, isMatch, check, anyOf, allOf, char,+               withTransform, withError, except) where -import Control.Applicative (liftA2)-import Control.Monad       (join)-import Data.Either         (fromRight)-import Data.List           (find)-import Data.Maybe          (isJust)-import Data.Text           (Text, pack, uncons, unpack)+import Bookhound.Utils.Foldable (findJust)+import Control.Applicative      (liftA2)+import Data.Either              (fromRight)+import Data.Maybe               (fromMaybe)+import Data.Text                (Text, pack, uncons, unpack)  type Input = Text @@ -15,6 +14,7 @@   = P       { parse     :: Input -> ParseResult a       , transform :: forall b. Maybe (Parser b -> Parser b)+      , error     :: Maybe ParseError       }  data ParseResult a@@ -28,6 +28,7 @@   | UnexpectedChar Char   | UnexpectedString String   | NoMatch String+  | ErrorAt String   deriving (Eq, Show)  @@ -40,6 +41,7 @@   show (Error (UnexpectedChar c))   = "Unexpected char: "   <> "[" <> show c <> "]"   show (Error (UnexpectedString s)) = "Unexpected string: " <> "[" <> show s <> "]"   show (Error (NoMatch s))          = "Did not match condition: " <> s+  show (Error (ErrorAt s))          = "Error at " <> s   instance Functor ParseResult where@@ -48,80 +50,89 @@   instance Functor Parser where-  fmap f (P p t) = applyTransform t $ mkParser (fmap f . p)+  fmap f (P p t e) = applyTransformError t e $+    mkParser (fmap f . p)  instance Applicative Parser where   pure a      = mkParser (`Result` a)-  (liftA2) f (P p t) mb@(P _ t') =-    applyTransform (findJust t t') combinedParser+  liftA2 f (P p t e) mb@(P _ t' e') =+    applyTransformsErrors [t, t'] [e, e'] combinedParser     where-      combinedParser = mkParser (-        \x -> case p x of-        Result i a -> parse ((f a) <$> mb) i-        Error pe   -> Error pe)+      combinedParser = mkParser \x ->+        case p x of+          Result i a -> parse ((f a) <$> mb) i+          Error pe   -> Error pe  instance Monad Parser where-  (>>=) (P p t) f = applyTransform t combinedParser+  (>>=) (P p t e) f = applyTransformError t e combinedParser     where-      combinedParser = mkParser (-        \x -> case  p x of-        Result i a -> parse (f a) i-        Error pe   -> Error pe)+      combinedParser = mkParser \x ->+        case p x of+          Result i a -> parse (f a) i+          Error pe   -> Error pe  runParser :: Parser a -> Input -> Either ParseError a-runParser p i = toEither $ parse (exactly p) i where--  toEither = \case-    Error pe   -> Left pe-    Result _ a -> Right a+runParser p@(P _ _ err) i = toEither $ parse (exactly p) i+  where+    toEither = \case+      Error pe   -> Left $ fromMaybe pe err+      Result _ a -> Right a  errorParser :: ParseError -> Parser a errorParser = mkParser . const . Error +andThen :: Parser String -> Parser a -> Parser a+andThen p1 p2@(P _ t e) = applyTransformError t e $+  P (\i -> parse p2 $ fromRight i $ pack <$> runParser p1 i) t e  char :: Parser Char char = mkParser $    maybe (Error UnexpectedEof) (\(ch, rest) -> Result rest ch) . uncons  -andThen :: Parser String -> Parser a -> Parser a-andThen p1 p2@(P _ t) = applyTransform t $-  P (\i -> parse p2 $ fromRight i $ pack <$> runParser p1 i) t-- exactly :: Parser a -> Parser a-exactly (P p t) = applyTransform t $ mkParser (-  \x -> case p x of-    result@(Result i _) | i == mempty -> result-    Result i _                        -> Error $ ExpectedEof i-    err@(Error _)                     -> err)+exactly (P p t e) = applyTransformError t e $+  mkParser (\x ->+    case p x of+      result@(Result i _) | i == mempty -> result+      Result i _                        -> Error $ ExpectedEof i+      err@(Error _)                     -> err+    )  anyOf :: [Parser a] -> Parser a-anyOf ps = anyOfHelper ps Nothing+anyOf ps = anyOfHelper ps Nothing Nothing  allOf :: [Parser a] -> Parser a-allOf ps = allOfHelper ps Nothing+allOf ps = allOfHelper ps Nothing Nothing  -anyOfHelper :: [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a-anyOfHelper [] _  = errorParser $ NoMatch "anyOf"-anyOfHelper [p] _ = p-anyOfHelper ((P p t) : rest) t' = applyTransform (findJust t t') $-  mkParser (-   \x -> case p x of-    result@(Result _ _) -> result-    Error _             -> parse (anyOfHelper rest t) x)+anyOfHelper :: [Parser a]+            -> (forall b. Maybe (Parser b -> Parser b))+            -> Maybe ParseError+            -> Parser a+anyOfHelper [] _ _  = errorParser $ NoMatch "anyOf"+anyOfHelper [p] _ _ = p+anyOfHelper ((P p t e) : rest) t' e' = applyTransformsErrors [t, t'] [e, e'] $+  mkParser (\x ->+    case p x of+      result@(Result _ _) -> result+      Error _             -> parse (anyOfHelper rest t e) x+    )   -allOfHelper :: [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a-allOfHelper [] _ = errorParser $ NoMatch "allOf"-allOfHelper [p] _ = p-allOfHelper ((P p t) : rest) t' = applyTransform (findJust t t') $-  mkParser (-   \x -> case p x of-    Result _ _    -> parse (allOfHelper rest t) x-    err@(Error _) -> err)+allOfHelper :: [Parser a]+            -> (forall b. Maybe (Parser b -> Parser b))+            -> Maybe ParseError+            -> Parser a+allOfHelper [] _ _ = errorParser $ NoMatch "allOf"+allOfHelper [p] _ _ = p+allOfHelper ((P p t e) : rest) t' e' = applyTransformsErrors [t, t'] [e, e'] $+  mkParser (\x ->+    case p x of+      Result _ _    -> parse (allOfHelper rest t e) x+      err@(Error _) -> err+    )   @@ -140,28 +151,40 @@        else  errorParser $ NoMatch condName  -except :: Show a => Parser a -> Parser a -> Parser a-except (P p t) (P p' _) = applyTransform t $ mkParser (+except :: Parser a -> Parser a -> Parser a+except (P p t e) (P p' _ _) = applyTransformError t e $ mkParser (   \x -> case p' x of-    Result _ a -> Error $ UnexpectedString (show a)-    Error _    -> p x)+    Result _ _ -> Error $ NoMatch "except"+    Error _    -> p x+  )  withError :: String -> Parser a -> Parser a-withError str parser@(P p _) = parser { parse =-  \i -> case p i of-    r@(Result _ _) -> r-    Error _        -> Error $ NoMatch str-  }+withError = applyError . pure . ErrorAt  withTransform :: (forall b. Parser b -> Parser b) -> Parser a -> Parser a-withTransform f = applyTransform $ Just f+withTransform t = applyTransform $ Just t  -applyTransform :: (forall a. Maybe (Parser a -> Parser a)) -> Parser b -> Parser b-applyTransform f p =  maybe p (\f' -> (f' p){transform = f} ) f+applyTransformError :: (forall b. Maybe (Parser b -> Parser b))+                    -> Maybe ParseError+                    -> Parser a+                    -> Parser a+applyTransformError t e = applyTransform t . applyError e -mkParser :: (Input -> ParseResult a) -> Parser a-mkParser p = P {parse = p, transform = Nothing} -findJust :: forall a. Maybe a -> Maybe a -> Maybe a-findJust ma mb = join $ find isJust ([ma, mb] :: [Maybe a])+applyTransformsErrors :: (forall b. [Maybe (Parser b -> Parser b)])+                      -> [Maybe ParseError]+                      -> Parser a+                      -> Parser a+applyTransformsErrors ts es =+  applyTransformError (findJust ts) (findJust es)+++applyTransform :: (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a+applyTransform f p =  maybe p (\f' -> (f' p) {transform = f}) f++applyError :: Maybe ParseError -> Parser a -> Parser a+applyError e p = maybe p (\_ -> p {error = e}) e++mkParser :: (Input -> ParseResult a) -> Parser a+mkParser p = P {parse = p, transform = Nothing, error = Nothing}

@@ -7,11 +7,11 @@                           anySepBy, someSepBy, multipleSepBy, sepByOp,                           (<|>), (<?>), (<#>), (->>-), (|?), (|*), (|+), (|++))  where +import Bookhound.Parser            (Parser, allOf, anyOf, char, check, except,+                                    isMatch, withError) import Bookhound.Utils.Applicative (extract) import Bookhound.Utils.Foldable    (hasMultiple, hasSome) import Bookhound.Utils.String      (ToString (..))-import Bookhound.Parser               (Parser, allOf, anyOf, char, check,-                                       except, isMatch, withError)  import Data.List  (isInfixOf) import Data.Maybe (listToMaybe)

@@ -2,7 +2,7 @@  import Bookhound.Parser            (ParseError (..), Parser, errorParser,                                     withError)-import Bookhound.ParserCombinators (IsMatch (..), (<|>), (->>-), (|+), (|?))+import Bookhound.ParserCombinators (IsMatch (..), (->>-), (<|>), (|+), (|?)) import Bookhound.Parsers.Char      (dash, digit, dot, plus)  

@@ -1,8 +1,10 @@ module Bookhound.Utils.Foldable where  import Bookhound.Utils.String (indent)-import Data.Foldable             as Foldable (Foldable (toList))-import Data.List                 (intercalate)+import Control.Monad          (join)+import Data.Foldable          as Foldable (Foldable (toList), find)+import Data.List              (intercalate)+import Data.Maybe             (isJust)   hasNone :: Foldable m => m a -> Bool@@ -20,3 +22,6 @@   where     str = intercalate sep list     list = toList xs++findJust :: Foldable t => t (Maybe a) -> Maybe a+findJust ms = join $ Foldable.find isJust ms

@@ -4,5 +4,7 @@   showMap :: String -> (String -> String) -> (a -> String) -> Map String a -> [String]-showMap sep showKey showValue mapping = (\(k, v) -> showKey k <> sep <> showValue v) <$> tuples where-  tuples = zip (keys mapping) (elems mapping)+showMap sep showKey showValue mapping =+  (\(k, v) -> showKey k <> sep <> showValue v) <$> tuples+  where+    tuples = zip (keys mapping) (elems mapping)