bookhound 0.1.23.0 → 0.1.24.0

raw patch · 2 files changed

+28/−62 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• bookhound.cabal +1/−1
• src/Bookhound/Parser.hs +27/−61

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           bookhound-version:        0.1.23.0+version:        0.1.24.0 synopsis:       Simple Parser Combinators description:    Please see the README on GitHub at <https://github.com/albertprz/bookhound#readme> category:       Parser Combinators

@@ -1,11 +1,10 @@-module Bookhound.Parser (Parser, ParseError(..), runParser, errorParser,+module Bookhound.Parser (Parser, ParseResult, ParseError(..), runParser, errorParser,                andThen, exactly, isMatch, check, anyOf, allOf, char,-               withTransform, withError, withErrorN, withErrorFrom, mapError, except, nonConsumingParser) where+               withTransform, withError, withErrorN, except) where  import           Bookhound.Utils.Foldable (findJust) import           Control.Applicative      (liftA2) import           Data.Either              (fromRight)-import           Data.Maybe               (fromMaybe) import           Data.Set                 (Set) import qualified Data.Set                 as Set import           Data.Text                (Text, pack, uncons, unpack)@@ -20,7 +19,7 @@       }  data ParseResult a-  = Result Input (Maybe ParseError) a+  = Result Input a   | Error ParseError   deriving (Eq) @@ -35,8 +34,8 @@   instance Show a => Show (ParseResult a) where-  show (Result i _ a) = "Pending: " <> " >" <> unpack i <> "< "-                                    <> "\n\nResult: \n" <> show a+  show (Result i a) = "Pending: " <> " >" <> unpack i <> "< "+                                  <> "\n\nResult: \n" <> show a   show (Error err)  = show err  instance Show ParseError where@@ -52,8 +51,8 @@   instance Functor ParseResult where-  fmap f (Result i pe a) = Result i pe (f a)-  fmap _ (Error pe)      = Error pe+  fmap f (Result i a) = Result i (f a)+  fmap _ (Error pe)   = (Error pe)   instance Functor Parser where@@ -61,33 +60,35 @@     mkParser (fmap f . p)  instance Applicative Parser where-  pure a      = mkParser (\x -> Result x Nothing a)+  pure a      = mkParser (`Result` a)   liftA2 f (P p t e) mb@(P _ t' e') =     applyTransformsErrors [t, t'] [e, e'] $ mkParser (\x ->       case p x of-        Result i pe a -> mapErrorResult (const pe) $-                          parse ((f a) <$> mb) i-        Error pe      -> Error pe+        Result i a -> parse ((f a) <$> mb) i+        Error pe   -> Error pe     )  instance Monad Parser where   (>>=) (P p t e) f =     applyTransformError t e $ mkParser (\x ->       case p x of-        Result i pe a -> mapErrorResult (const pe) $-                         parse (f a) i-        Error pe      -> Error pe+        Result i a -> parse (f a) i+        Error pe   -> Error pe     )  runParser :: Parser a -> Input -> Either [ParseError] a runParser p@(P _ _ e) i = toEither $ parse (exactly p) i   where     toEither = \case-      Result _ _ a -> Right a+      Result _ a -> Right a       Error pe   -> Left $ filter (hasPriorityError)   [pe]   <>                           (snd <$> reverse (Set.toList e))   <>                           filter (not . hasPriorityError) [pe] +hasPriorityError :: ParseError -> Bool+hasPriorityError (ErrorAt _) = True+hasPriorityError _           = False+ errorParser :: ParseError -> Parser a errorParser = mkParser . const . Error @@ -97,17 +98,16 @@  char :: Parser Char char = mkParser $-   maybe (Error UnexpectedEof) (\(ch, rest) -> Result rest Nothing ch)-   . uncons+   maybe (Error UnexpectedEof) (\(ch, rest) -> Result rest ch) . uncons   exactly :: Parser a -> Parser a 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                                 -> err+      result@(Result i _) | i == mempty -> result+      Result i _                        -> Error $ ExpectedEof i+      err                               -> err     )  anyOf :: [Parser a] -> Parser a@@ -127,9 +127,8 @@   applyTransformsErrors [t, t'] [e, e'] $     mkParser (\x ->       case p x of-        Error pe -> mapErrorResult (const $ wrapMaybeError pe) $-                     parse (anyOfHelper rest t e) x-        result   -> result+        Error _ -> parse (anyOfHelper rest t e) x+        result  -> result       )  @@ -143,9 +142,8 @@   applyTransformsErrors [t, t'] [e, e'] $     mkParser (\x ->       case p x of-        Result _ pe _ -> mapErrorResult (const pe) $-                          parse (allOfHelper rest t e) x-        err          -> err+        Result _ _ -> parse (allOfHelper rest t e) x+        err        -> err       )  @@ -167,8 +165,8 @@ except :: Parser a -> Parser a -> Parser a except (P p t e) (P p' _ _) = applyTransformError t e $ mkParser (   \x -> case p' x of-    Result _ _ _ -> Error $ NoMatch "except"-    Error _      -> p x+    Result _ _ -> Error $ NoMatch "except"+    Error _    -> p x   )  withError :: String -> Parser a -> Parser a@@ -177,29 +175,12 @@ withErrorN :: Int -> String -> Parser a -> Parser a withErrorN n str = applyError . Set.singleton $ (n, ErrorAt str) -withErrorFrom :: (a -> String) -> Parser a -> Parser b -> Parser b-withErrorFrom errFn pDoc p =-  do value <- nonConsumingParser pDoc-     mapError (const $ pure $ ErrorAt $ errFn value) p -mapError :: (ParseError -> Maybe ParseError) -> Parser a -> Parser a-mapError f (P p t e) = applyTransformError t e $-  mkParser $ mapErrorResult f . p--- withTransform :: (forall b. Parser b -> Parser b) -> Parser a -> Parser a withTransform t = applyTransform $ Just t  -nonConsumingParser :: Parser a -> Parser a-nonConsumingParser (P p t e) = applyTransformError t e $ mkParser (-  \x -> case p x of-    Result _ pe a -> Result x pe a-    err           -> err-  ) - applyTransformsErrors :: (forall b. [Maybe (Parser b -> Parser b)])                       -> [Set (Int, ParseError)]                       -> Parser a@@ -215,21 +196,6 @@ applyTransformError t e = applyTransform t . applyError e  --mapErrorResult :: (ParseError -> Maybe ParseError)-               -> ParseResult a-               -> ParseResult a-mapErrorResult f (Error pe)      = Error $ fromMaybe pe $ f pe-mapErrorResult f (Result i pe a) = Result i (fromMaybe pe $ f <$> pe) a---wrapMaybeError :: ParseError -> Maybe ParseError-wrapMaybeError pe | hasPriorityError pe = pure pe-                  | otherwise = Nothing--hasPriorityError :: ParseError -> Bool-hasPriorityError (ErrorAt _) = True-hasPriorityError _           = False  applyTransform :: (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a applyTransform f p =  maybe p (\f' -> (f' p) {transform = f}) f