bookhound 0.1.25.0 → 0.1.26.0

raw patch · 19 files changed

+647/−642 lines, 19 filesdep +mtldep ~basedep ~containersdep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: mtl

Dependency ranges changed: base, containers, text, time

API changes (from Hackage documentation)

Files

• bookhound.cabal +19/−52
• src/Bookhound/Parser.hs +123/−119
• src/Bookhound/ParserCombinators.hs +109/−85
• src/Bookhound/Parsers/Char.hs +29/−13
• src/Bookhound/Parsers/Collections.hs +9/−9
• src/Bookhound/Parsers/DateTime.hs +10/−10
• src/Bookhound/Parsers/Number.hs +32/−39
• src/Bookhound/Parsers/String.hs +0/−100
• src/Bookhound/Parsers/Text.hs +107/−0
• src/Bookhound/Utils/Applicative.hs +0/−5
• src/Bookhound/Utils/Foldable.hs +5/−15
• src/Bookhound/Utils/List.hs +11/−0
• src/Bookhound/Utils/String.hs +0/−36
• src/Bookhound/Utils/Text.hs +40/−0
• test/Bookhound/ParserCombinatorsSpec.hs +52/−56
• test/Bookhound/ParserSpec.hs +78/−75
• test/Bookhound/Parsers/CollectionsSpec.hs +8/−7
• test/Bookhound/Parsers/DateTimeSpec.hs +8/−7
• test/Bookhound/Parsers/NumberSpec.hs +7/−14

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.0.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           bookhound-version:        0.1.25.0+version:        0.1.26.0 synopsis:       Simple Parser Combinators description:    Please see the README on GitHub at <https://github.com/albertprz/bookhound#readme> category:       Parser Combinators@@ -32,13 +32,12 @@       Bookhound.Parsers.Collections       Bookhound.Parsers.DateTime       Bookhound.Parsers.Number-      Bookhound.Parsers.String-      Bookhound.Utils.Applicative+      Bookhound.Parsers.Text       Bookhound.Utils.DateTime       Bookhound.Utils.Foldable       Bookhound.Utils.List       Bookhound.Utils.Map-      Bookhound.Utils.String+      Bookhound.Utils.Text   other-modules:       Paths_bookhound   hs-source-dirs:@@ -47,40 +46,24 @@       LambdaCase       MultiWayIf       TupleSections-      PostfixOperators       BlockArguments+      PostfixOperators       RankNTypes-      ExplicitForAll       ScopedTypeVariables-      LiberalTypeSynonyms-      InstanceSigs-      FunctionalDependencies       DuplicateRecordFields       NamedFieldPuns       RecordWildCards-      ConstrainedClassMethods       MultiParamTypeClasses-      FlexibleContexts       FlexibleInstances       ApplicativeDo-      ParallelListComp-      MonadComprehensions-      GADTs-      TypeFamilies-      TypeFamilyDependencies-      DataKinds-      PolyKinds-      DeriveFunctor-      DeriveFoldable-      DeriveTraversable-      DeriveGeneric-      GeneralizedNewtypeDeriving+      OverloadedStrings   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wincomplete-uni-patterns -Wredundant-constraints   build-depends:-      base >=4.7 && <5-    , containers >=0.6 && <1-    , text-    , time >=1.9 && <2+      base ==4.*+    , containers ==0.6.*+    , mtl ==2.*+    , text >=2.0 && <3+    , time ==1.*   default-language: Haskell2010  test-suite test@@ -99,44 +82,28 @@       LambdaCase       MultiWayIf       TupleSections-      PostfixOperators       BlockArguments+      PostfixOperators       RankNTypes-      ExplicitForAll       ScopedTypeVariables-      LiberalTypeSynonyms-      InstanceSigs-      FunctionalDependencies       DuplicateRecordFields       NamedFieldPuns       RecordWildCards-      ConstrainedClassMethods       MultiParamTypeClasses-      FlexibleContexts       FlexibleInstances       ApplicativeDo-      ParallelListComp-      MonadComprehensions-      GADTs-      TypeFamilies-      TypeFamilyDependencies-      DataKinds-      PolyKinds-      DeriveFunctor-      DeriveFoldable-      DeriveTraversable-      DeriveGeneric-      GeneralizedNewtypeDeriving-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wincomplete-uni-patterns -Wredundant-constraints -Wno-orphans+      OverloadedStrings+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wincomplete-uni-patterns -Wredundant-constraints -Wno-type-defaults   build-tool-depends:       hspec-discover:hspec-discover   build-depends:       QuickCheck-    , base >=4.7 && <5+    , base ==4.*     , bookhound-    , containers >=0.6 && <1+    , containers ==0.6.*     , hspec+    , mtl ==2.*     , quickcheck-instances-    , text-    , time >=1.9 && <2+    , text >=2.0 && <3+    , time ==1.*   default-language: Haskell2010

@@ -1,15 +1,14 @@-module Bookhound.Parser (Parser(parse), ParseResult(..), ParseError(..), runParser, errorParser,-               andThen, exactly, isMatch, check, anyOf, allOf, char,-               withTransform, withError, withErrorN, except) where--import           Bookhound.Utils.Foldable (findJust)-import           Control.Applicative      (liftA2)-import           Data.Either              (fromRight)-import           Data.Set                 (Set)-import qualified Data.Set                 as Set-import           Data.Text                (Text, pack, uncons, unpack)+module Bookhound.Parser (Parser(parse), ParseResult(..), ParseError(..), mkParser, runParser, throwError, andThen, exactly, eof , lookAhead , notFollowedBy, both, choice, anyOf, allOf, anyChar, satisfy, withTransform, withError, withErrorN, except) where -type Input = Text+import           Bookhound.Utils.Foldable  (findJust)+import           Control.Applicative       (Alternative (..), liftA2)+import           Control.Monad             (MonadPlus)+import           Control.Monad.Error.Class (MonadError (..))+import           Data.Either               (fromRight)+import           Data.Set                  (Set)+import qualified Data.Set                  as Set+import           Data.Text                 (Text, unpack)+import qualified Data.Text                 as Text  data Parser a   = P@@ -18,26 +17,6 @@       , errors    :: Set (Int, ParseError)       } -data ParseResult a-  = Result Input a-  | Error ParseError-  deriving (Eq)--data ParseError-  = UnexpectedEof-  | ExpectedEof Input-  | UnexpectedChar Char-  | UnexpectedString String-  | NoMatch String-  | ErrorAt String-  deriving (Eq, Ord)---instance Functor ParseResult where-  fmap f (Result i a) = Result i (f a)-  fmap _ (Error pe)   = Error pe-- instance Functor Parser where   fmap f (P p t e) = applyTransformError t e $     mkParser (fmap f . p)@@ -45,138 +24,134 @@ instance Applicative Parser where   pure a      = mkParser (`Result` a)   liftA2 f (P p t e) mb@(P _ t' e') =-    applyTransformsErrors [t, t'] [e, e'] $ mkParser (\x ->+    applyTransformsErrors [t, t'] [e, e'] $ 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 e) f =-    applyTransformError t e $ mkParser (\x ->+    applyTransformError t e $ mkParser \x ->       case p x of         Result i a -> parse (f a) i         Error pe   -> Error pe-    ) +instance Semigroup a => Semigroup (Parser a) where+  (<>) = liftA2 (<>)++instance Monoid a => Monoid (Parser a) where+  mempty = pure mempty++instance Alternative Parser where+  (<|>) (P p t e) (P p' t' e') =+    applyTransformsErrors [ t, t' ] [ e, e' ] $+      mkParser+        \x -> case p x of+          Error _ -> p' x+          result  -> result+  empty = mkParser \i ->+    if Text.null i then+      Error UnexpectedEof+    else+      Error $ ExpectedEof i++instance MonadPlus Parser++instance MonadError ParseError Parser where+  throwError = mkParser . const . Error+  catchError p errFn = mkParser+        \x -> case parse p x of+          Error err -> parse (errFn err) x+          result    -> result++anyChar :: Parser Char+anyChar = mkParser $+   maybe (Error UnexpectedEof) (uncurry $ flip Result) . Text.uncons+ runParser :: Parser a -> Input -> Either [ParseError] a runParser p@(P _ _ e) i = toEither $ parse (exactly p) i   where     toEither = \case       Result _ a -> Right a-      Error pe   -> Left $ filter hasPriorityError       [pe] <>-                          (snd <$> reverse (Set.toList e))   <>-                          filter (not . hasPriorityError) [pe]--errorParser :: ParseError -> Parser a-errorParser = mkParser . const . Error+      Error pe   -> Left $ filter hasPriorityError [pe]+        <> (snd <$> reverse (Set.toList e))+        <> filter (not . hasPriorityError) [pe] -andThen :: Parser String -> Parser a -> Parser a+andThen :: Parser Text -> Parser a -> Parser a andThen p1 p2@(P _ t e) = applyTransformError t e $-  mkParser (\i -> parse p2 $ fromRight i $ pack <$> runParser p1 i)--char :: Parser Char-char = mkParser $-   maybe (Error UnexpectedEof) (\(ch, rest) -> Result rest ch) . uncons-+  mkParser (\i -> parse p2 $ fromRight i (runParser p1 i))  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-    )--anyOf :: [Parser a] -> Parser a-anyOf ps = anyOfHelper ps Nothing mempty--allOf :: [Parser a] -> Parser a-allOf ps = allOfHelper ps Nothing mempty---anyOfHelper :: [Parser a]-            -> (forall b. Maybe (Parser b -> Parser b))-            -> Set (Int, 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-        Error _ -> parse (anyOfHelper rest t e) x-        result  -> result-      )+exactly p = p <* eof +eof :: Parser ()+eof = mkParser \i ->+    if i == mempty then+      Result i ()+    else+      Error $ ExpectedEof i -allOfHelper :: [Parser a]-            -> (forall b. Maybe (Parser b -> Parser b))-            -> Set (Int, 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+lookAhead :: Parser a -> Parser a+lookAhead (P p t e) =+  applyTransformError t e $+    mkParser+      \x -> case p x of+        Result _ a -> Result x a         err        -> err-      ) +notFollowedBy :: Parser a -> Parser ()+notFollowedBy (P p t e) =+  applyTransformError t e $+    mkParser+      \x -> case p x of+        Result _ _ -> Error UnexpectedEof+        _          -> Result x () -isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char-isMatch cond parser c1 =-  do c2 <- parser-     if cond c1 c2-       then pure c2-       else errorParser $ UnexpectedChar c2+choice :: Foldable f => f (Parser a) -> Parser a+choice = anyOf -check :: String -> (a -> Bool) -> Parser a -> Parser a-check condName cond parser =-  do c2 <- parser-     if cond c2-       then pure c2-       else errorParser $ NoMatch condName+anyOf :: Foldable f => f (Parser a) -> Parser a+anyOf = foldl (<|>) empty +allOf :: Foldable f => f (Parser a) -> Parser a+allOf = foldl both (pure undefined) +both :: Parser a -> Parser a -> Parser a+both (P p t e) (P p' t' e') =+  applyTransformsErrors [ t, t' ] [ e, e' ] $+    mkParser+      \x -> case p x of+        Result _ _ -> p' x+        err        -> err+ 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"+    Result _ _ -> Error $ ExpectedEof x     Error _    -> p x   ) -withError :: String -> Parser a -> Parser a+satisfy :: (a -> Bool) -> Parser a -> Parser a+satisfy cond ma = do+  c2 <- ma+  if cond c2 then+    pure c2+  else+    empty++withError :: Text -> Parser a -> Parser a withError = withErrorN 0 -withErrorN :: Int -> String -> Parser a -> Parser a+withErrorN :: Int -> Text -> Parser a -> Parser a withErrorN n str = applyError . Set.singleton $ (n, ErrorAt str)   withTransform :: (forall b. Parser b -> Parser b) -> Parser a -> Parser a withTransform t = applyTransform $ Just t -instance Show a => Show (ParseResult a) where-  show (Result i a) = "Pending: " <> " >" <> unpack i <> "< "-                                  <> "\n\nResult: \n" <> show a-  show (Error err)  = show err -instance Show ParseError where-  show UnexpectedEof        = "Unexpected end of stream"-  show (ExpectedEof i)      = "Expected end of stream, but got "-                               <> ">" <> unpack i <> "<"-  show (UnexpectedChar c)   = "Unexpected char: "-                               <> "[" <> show c <> "]"-  show (UnexpectedString s) = "Unexpected string: "-                               <> "[" <> s <> "]"-  show (NoMatch s)          = "Did not match condition: " <> s-  show (ErrorAt s)          = "Error at " <> s  -- applyTransformsErrors :: (forall b. [Maybe (Parser b -> Parser b)])                       -> [Set (Int, ParseError)]                       -> Parser a@@ -206,3 +181,32 @@ hasPriorityError :: ParseError -> Bool hasPriorityError (ErrorAt _) = True hasPriorityError _           = False++data ParseResult a+  = Result Input a+  | Error ParseError+  deriving (Eq)++instance Functor ParseResult where+  fmap f (Result i a) = Result i (f a)+  fmap _ (Error pe)   = Error pe+++instance Show a => Show (ParseResult a) where+  show (Result i a) = "Pending: " <> " >" <> unpack i <> "< "+                                  <> "\n\nResult: \n" <> show a+  show (Error err)  = show err++data ParseError+  = UnexpectedEof+  | ExpectedEof Input+  | ErrorAt Text+  deriving (Eq, Ord)++instance Show ParseError where+  show UnexpectedEof        = "Unexpected end of stream"+  show (ExpectedEof i)      = "Expected end of stream, but got "+                               <> ">" <> unpack i <> "<"+  show (ErrorAt s)          = "Error at " <> unpack s++type Input = Text

@@ -1,24 +1,17 @@-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}-{-# HLINT ignore "Use optional" #-}--module Bookhound.ParserCombinators (IsMatch(..), satisfies, contains, notContains,-                          containsAnyOf, containsNoneOf,-                          times, maybeTimes, anyTimes, someTimes, multipleTimes,-                          within, maybeWithin, withinBoth, maybeWithinBoth,-                          anySepBy, someSepBy, multipleSepBy, sepByOps, 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 (..))+module Bookhound.ParserCombinators (IsMatch(..), satisfy, char, string, times, many, some, multiple,+                          between, maybeBetween, surroundedBy, maybeSurroundedBy,+                          manySepBy, someSepBy, multipleSepBy, sepByOps, sepByOp, manyEndBy, someEndBy, multipleEndBy,+                          (<?>), (<#>), (</\>), (<:>), (->>-), (|?), (|*), (|+), (|++), (||?), (||*), (||+), (||++))  where+import Bookhound.Parser (Parser, allOf, anyChar, anyOf, except, satisfy,+                         withError) -import Data.List (isInfixOf)+import Bookhound.Utils.List (hasMultiple, hasSome)+import Bookhound.Utils.Text (ToText (..))+import Control.Applicative  (liftA2, optional, (<|>)) -import           Data.Bifunctor (Bifunctor (first))-import qualified Data.Foldable  as Foldable+import qualified Data.Foldable as Foldable+import           Data.Text     (Text, pack, unpack)+import qualified Data.Text     as Text   class IsMatch a where@@ -31,124 +24,155 @@   oneOf xs  = anyOf $ is <$> xs   noneOf xs = allOf $ isNot <$> xs - instance   IsMatch Char where-  is      = isMatch (==) char-  isNot   = isMatch (/=) char-  inverse = except char+  is      = isMatch (==) anyChar+  isNot   = isMatch (/=) anyChar+  inverse = except anyChar  instance   IsMatch String where-  is      = traverse (isMatch (==) char)-  isNot   = traverse (isMatch (/=) char)-  inverse = except (char |*)+  is      = traverse is+  isNot   = traverse is+  inverse = except (anyChar |*) -instance {-# OVERLAPPABLE #-} (Num a, Read a, Show a) => IsMatch a where-  is n      = read <$> (is . show) n-  isNot n   = read <$> (isNot . show) n-  inverse p = read <$> inverse (show <$> p)+instance   IsMatch Text where+  is      = fmap pack . is . unpack+  isNot   = fmap pack . is . unpack+  inverse = except (anyChar ||*)  --- Condition combinators-satisfies :: (a -> Bool) -> Parser a -> Parser a-satisfies = check "satisfies"--contains :: Eq a => [a] -> Parser [a] -> Parser [a]-contains val = check "contains" (isInfixOf val)--notContains :: Eq a => [a] -> Parser [a] -> Parser [a]-notContains val = check "notContains" (isInfixOf val)--containsAnyOf :: (Foldable t, Eq a) => t [a] -> Parser [a] -> Parser [a]-containsAnyOf x y = foldr contains y x+isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char+isMatch cond p c1 = satisfy (cond c1) p -containsNoneOf :: (Foldable t, Eq a) => t [a] -> Parser [a] -> Parser [a]-containsNoneOf x y = foldr notContains y x+char :: Char -> Parser Char+char = is +string :: Text -> Parser Text+string = is   -- Frequency combinators-times :: Int -> Parser a  -> Parser [a]-times n p = sequence $ p <$ [1 .. n]---maybeTimes :: Parser a -> Parser (Maybe a)-maybeTimes p = Just <$> p <|> pure Nothing+many :: Parser a -> Parser [a]+many p = (p >>= \x -> (x :) <$> many p)+  <|> pure [] -anyTimes :: Parser a -> Parser [a]-anyTimes p = (p >>= \x -> (x :) <$> anyTimes p) <|> pure []+some :: Parser a -> Parser [a]+some = satisfy hasSome . many -someTimes :: Parser a -> Parser [a]-someTimes = check "someTimes" hasSome . anyTimes+multiple :: Parser a -> Parser [a]+multiple = satisfy hasMultiple . many -multipleTimes :: Parser a -> Parser [a]-multipleTimes = check "multipleTimes" hasMultiple . anyTimes+times :: Int -> Parser a  -> Parser [a]+times n p+  | n < 1 = pure []+  | otherwise = sequence $ p <$ [1 .. n]  --- Within combinators-withinBoth :: Parser a -> Parser b -> Parser c -> Parser c-withinBoth = extract+-- Between combinators+between :: Parser a -> Parser b -> Parser c -> Parser c+between start end p = start *> p <* end -maybeWithinBoth :: Parser a -> Parser b -> Parser c -> Parser c-maybeWithinBoth p1 p2 = withinBoth (p1 |?) (p2 |?)+maybeBetween :: Parser a -> Parser b -> Parser c -> Parser c+maybeBetween p1 p2 = between (p1 |?) (p2 |?) -within :: Parser a -> Parser b -> Parser b-within p = withinBoth p p+surroundedBy :: Parser a -> Parser b -> Parser b+surroundedBy p = between p p -maybeWithin :: Parser a -> Parser b -> Parser b-maybeWithin p = within (p |?)+maybeSurroundedBy :: Parser a -> Parser b -> Parser b+maybeSurroundedBy p = surroundedBy (p |?)  --- Separated by combinators+-- Sep by combinators sepBy :: (Parser b -> Parser (Maybe b)) -> (Parser b -> Parser [b])                 -> Parser a -> Parser b -> Parser [b] sepBy freq1 freq2 sep p = (<>) <$> (Foldable.toList <$> freq1 p)                                <*> freq2 (sep *> p) -anySepBy :: Parser a -> Parser b -> Parser [b]-anySepBy = sepBy (|?) (|*)+manySepBy :: Parser a -> Parser b -> Parser [b]+manySepBy = sepBy optional many  someSepBy :: Parser a -> Parser b -> Parser [b]-someSepBy = sepBy (fmap Just) (|*)+someSepBy = sepBy (fmap Just) many  multipleSepBy :: Parser a -> Parser b -> Parser [b]-multipleSepBy = sepBy (fmap Just) (|+)+multipleSepBy = sepBy (fmap Just) some  sepByOps :: Parser a -> Parser b -> Parser ([a], [b]) sepByOps sep p = do x <-  p-                    y <- (((,) <$> sep <*> p) |+)-                    pure (fst <$> y, x : (snd <$> y))+                    y <- (|+) (sep </\> p)+                    pure (fmap fst y, x : fmap snd y)  sepByOp :: Parser a -> Parser b -> Parser (a, [b])-sepByOp sep p = first head <$> sepByOps sep p+sepByOp sepP p = do+  x1 <- p+  sep <- sepP+  x2 <- p+  xs <- (|*) (sepP *> p)+  pure (sep, x1 : x2 : xs) +-- End by combinators+endBy+  :: forall a b+   . (Parser b -> Parser (Maybe b))+  -> (Parser b -> Parser [b])+  -> Parser a+  -> Parser b+  -> Parser [b]+endBy freq1 freq2 sep p =+  sepBy freq1 freq2 sep p <* sep --- Parser Binary Operators-infixl 3 <|>-(<|>) :: Parser a -> Parser a -> Parser a-(<|>) p1 p2 = anyOf [p1, p2]+manyEndBy :: forall a b. Parser a -> Parser b -> Parser [ b]+manyEndBy = endBy optional many +someEndBy :: forall a b. Parser a -> Parser b -> Parser [ b]+someEndBy = endBy (fmap Just) many++multipleEndBy :: forall a b. Parser a -> Parser b -> Parser [ b]+multipleEndBy = endBy (fmap Just) some+++-- Parser Binary Operators infixl 6 <#> (<#>) :: Parser a -> Int -> Parser [a] (<#>) = flip times  infixl 6 <?>-(<?>) :: Parser a -> String -> Parser a+(<?>) :: Parser a -> Text -> Parser a (<?>) = flip withError  infixl 6 ->>--(->>-) :: (ToString a, ToString b) => Parser a -> Parser b -> Parser String-(->>-) p1 p2 = (<>) <$> (toString <$> p1)-                 <*> (toString <$> p2)+(->>-) :: (ToText a, ToText b) => Parser a -> Parser b -> Parser Text+(->>-) p1 p2 = (<>) <$> fmap toText p1+                 <*> fmap toText p2 +-- Apply Binary Operators+infixl 6 </\>+(</\>) :: Applicative f => f a -> f b -> f (a, b)+(</\>) = liftA2 (,) +infixl 6 <:>+(<:>) :: Applicative f => f a -> f [a] -> f [a]+(<:>) = liftA2 (:)+ -- Parser Unary Operators (|?) :: Parser a -> Parser (Maybe a)-(|?) = maybeTimes+(|?) = optional  (|*) :: Parser a -> Parser [a]-(|*) = anyTimes+(|*) = many  (|+) :: Parser a -> Parser [a]-(|+) = someTimes+(|+) = some  (|++) :: Parser a -> Parser [a]-(|++) = multipleTimes+(|++) = multiple++(||?) :: Parser Char -> Parser Text+(||?) = fmap (maybe mempty Text.singleton) . optional++(||*) :: Parser Char -> Parser Text+(||*) = fmap pack . many++(||+) :: Parser Char -> Parser Text+(||+) = fmap pack . some++(||++) :: Parser Char -> Parser Text+(||++) = fmap pack . multiple

@@ -1,28 +1,34 @@-module Bookhound.Parsers.Char where--import Bookhound.ParserCombinators (IsMatch (..), (<|>))+module Bookhound.Parsers.Char (module AnyChar, digit, hexDigit, octDigit, upper, lower, alpha, alphaNum, space, tab, newLine, spaceOrTab, whiteSpace, comma, dot, colon, quote, doubleQuote, dash, plus, equal, underscore, hashTag, question, openParens, closeParens, openSquare, closeSquare, openCurly, closeCurly, openAngle, closeAngle)  where -import Bookhound.Parser (Parser)+import qualified Bookhound.Parser            as AnyChar (anyChar)+import qualified Bookhound.Parser            as Parser+import           Bookhound.ParserCombinators (IsMatch (..)) +import Bookhound.Parser    (Parser, anyChar)+import Control.Applicative+import Data.Char           (isAsciiLower, isAsciiUpper, isDigit, isHexDigit,+                            isOctDigit)  digit :: Parser Char-digit = oneOf ['0' .. '9']+digit = satisfy isDigit +hexDigit :: Parser Char+hexDigit = satisfy isHexDigit++octDigit :: Parser Char+octDigit = satisfy isOctDigit+ upper :: Parser Char-upper = oneOf ['A' .. 'Z']+upper = satisfy isAsciiUpper  lower :: Parser Char-lower = oneOf ['a' .. 'z']--letter :: Parser Char-letter = upper <|> lower+lower = satisfy isAsciiLower  alpha :: Parser Char-alpha = letter+alpha = satisfy isAlpha  alphaNum :: Parser Char-alphaNum = alpha <|> digit-+alphaNum = satisfy isAlphaNum   space :: Parser Char@@ -98,3 +104,13 @@  closeAngle :: Parser Char closeAngle = is '>'+++isAlpha :: Char -> Bool+isAlpha x = isAsciiLower x || isAsciiUpper x++isAlphaNum :: Char -> Bool+isAlphaNum x = isAlpha x || isDigit x++satisfy :: (Char -> Bool) -> Parser Char+satisfy = flip Parser.satisfy anyChar

@@ -1,21 +1,21 @@ module Bookhound.Parsers.Collections (collOf, listOf, tupleOf, mapOf) where -import Bookhound.Parser            (Parser, withErrorN)-import Bookhound.ParserCombinators (anySepBy, maybeWithin, satisfies)+import Bookhound.Parser            (Parser, satisfy, withErrorN)+import Bookhound.ParserCombinators (manySepBy) import Bookhound.Parsers.Char      (closeCurly, closeParens, closeSquare, comma,                                     openCurly, openParens, openSquare)-import Bookhound.Parsers.String    (spacing)+import Bookhound.Parsers.Text      (maybeBetweenSpacing) -import           Bookhound.Utils.Foldable (hasMultiple)-import           Data.Map                 (Map)-import qualified Data.Map                 as Map+import           Bookhound.Utils.List (hasMultiple)+import           Data.Map             (Map)+import qualified Data.Map             as Map   collOf :: Parser a -> Parser b -> Parser c -> Parser d -> Parser [d] collOf start end sep elemParser =   start *> elemsParser <* end     where-      elemsParser = anySepBy sep $ maybeWithin spacing elemParser+      elemsParser = manySepBy sep $ maybeBetweenSpacing elemParser   listOf :: Parser a -> Parser [a]@@ -25,7 +25,7 @@  tupleOf :: Parser a -> Parser [a] tupleOf = withErrorN (-1) "Tuple"-  . satisfies hasMultiple+  . satisfy hasMultiple   . collOf openParens closeParens comma  @@ -33,4 +33,4 @@ mapOf sep p1 p2 = withErrorN (-1) "Map" $   Map.fromList <$> collOf openCurly closeCurly comma mapEntry     where-      mapEntry = (,) <$> p1 <* maybeWithin spacing sep <*> p2+      mapEntry = (,) <$> p1 <* maybeBetweenSpacing sep <*> p2

@@ -1,19 +1,19 @@ module Bookhound.Parsers.DateTime (date, time, timeZoneOffset, localDateTime, offsetDateTime, dateTime, year, day, month, hour, minute, second) where -import Bookhound.Parser            (Parser, check, withErrorN)-import Bookhound.ParserCombinators (IsMatch (..), within, (<#>), (<|>), (|+),+import Bookhound.Parser            (Parser, satisfy, withErrorN)+import Bookhound.ParserCombinators (IsMatch (..), surroundedBy, (<#>), (|+),                                     (|?)) import Bookhound.Parsers.Char      (colon, dash, digit, dot, plus)+import Control.Applicative  import Data.Maybe (fromMaybe) import Data.Time  (Day, LocalTime (..), TimeOfDay (..), TimeZone,                    ZonedTime (..), fromGregorian, minutesToTimeZone)  - date :: Parser Day date = withErrorN (-1) "Date" $-  fromGregorian <$> year <*> within dash month <*> day+  fromGregorian <$> year <*> surroundedBy dash month <*> day   time :: Parser TimeOfDay@@ -54,22 +54,22 @@ year = read <$> digit <#> 4  day :: Parser Int-day = check "Day" (range 1 31) $ read <$> digit <#> 2+day = withErrorN (-1) "Day" $ satisfy (range 1 31) $ read <$> digit <#> 2  month :: Parser Int-month = check "Month" (range 1 12) $ read <$> digit <#> 2+month = withErrorN (-1) "Month" $ satisfy (range 1 12) $ read <$> digit <#> 2  hour :: Parser Int-hour = check "Hour" (range 0 23) $ read <$> digit <#> 2+hour = withErrorN (-1) "Hour" $ satisfy (range 0 23) $ read <$> digit <#> 2  minute :: Parser Int-minute = check "Minute" (range 0 59) $ read <$> digit <#> 2+minute = withErrorN (-1) "Minute" $ satisfy (range 0 59) $ read <$> digit <#> 2  second :: Parser Int-second = check "Second" (range 0 59) $ read <$> digit <#> 2+second = withErrorN (-1) "Second" $ satisfy (range 0 59) $ read <$> digit <#> 2  secondDecimals :: Parser String-secondDecimals = check "Pico Seconds" ((<= 12) . length) (digit |+)+secondDecimals = withErrorN (-1) "Pico Seconds" $ satisfy ((<= 12) . length) (digit |+)   

@@ -1,52 +1,45 @@-module Bookhound.Parsers.Number (int, double, posInt, negInt, unsignedInt, hexInt, octInt, intLike) where+module Bookhound.Parsers.Number (int, double, posInt, negInt, unsignedInt, hexInt, octInt) where -import Bookhound.Parser            (ParseError (..), Parser, errorParser,-                                    withErrorN)-import Bookhound.ParserCombinators (IsMatch (..), (->>-), (<|>), (|+), (|?))+import Bookhound.Parser            (Parser, withErrorN)+import Bookhound.ParserCombinators (IsMatch (..), string, (->>-), (|?), (||+),+                                    (||?)) import Bookhound.Parsers.Char      (dash, digit, dot, plus)+import Control.Applicative+import Data.Text                   (Text, unpack)  -hexInt :: Parser Integer-hexInt = withErrorN (-1) "Hex Int"- $ read <$> (is "0x" ->>--             ((digit <|> oneOf ['A' .. 'F'] <|> oneOf ['a' .. 'f']) |+))+hexInt :: Parser Int+hexInt = withErrorN (-1) "Hex Int" $ readInt+  <$> (string "0x" ->>- ((digit <|> oneOf ['A' .. 'F'] <|> oneOf ['a' .. 'f']) ||+)) -octInt :: Parser Integer-octInt = withErrorN (-1) "Oct Int"-  $ read <$> (is "0o" ->>- (oneOf ['0' .. '7'] |+))+octInt :: Parser Int+octInt = withErrorN (-1) "Oct Int" $ readInt+  <$> (string "0o" ->>- (oneOf ['0' .. '7'] ||+)) -unsignedInt :: Parser Integer-unsignedInt = withErrorN (-1) "Unsigned Int"-  $ read <$> (digit |+)+unsignedInt :: Parser Int+unsignedInt = withErrorN (-1) "Unsigned Int" $ readInt+  <$> (digit ||+) -posInt :: Parser Integer-posInt = withErrorN (-1) "Positive Int"-  $ read <$> ((plus |?) *> (digit |+))+posInt :: Parser Int+posInt = withErrorN (-1) "Positive Int" $ readInt+  <$> ((plus ||?) *> (digit ||+)) -negInt :: Parser Integer-negInt = withErrorN (-1) "Negative Int"-  $ read <$> dash ->>- (digit |+)+negInt :: Parser Int+negInt = withErrorN (-1) "Negative Int" $ readInt+  <$> dash ->>- (digit ||+) -int :: Parser Integer-int = withErrorN (-1) "Int"-  $ negInt <|> posInt+int :: Parser Int+int = withErrorN (-1) "Int" $ negInt <|> posInt -intLike :: Parser Integer-intLike = parser <|> int+double :: Parser Double+double = withErrorN (-1) "Double" $ readDouble+  <$> int ->>- (decimals ->>- (expn |?) <|> expn)   where-    parser = do n1      <- show <$> int-                n2      <- show <$> (dot *> unsignedInt)-                expNum  <- oneOf ['e', 'E'] *> int--                if length n1 + length n2 <= fromInteger expNum then-                  pure . read $ n1 <> "." <> n2 <> "E" <> show expNum-                else-                  errorParser $ NoMatch "Int Like"-+  decimals = dot ->>- (digit ||+)+  expn      = oneOf ['e', 'E'] ->>- int -double :: Parser Double-double = withErrorN (-1) "Double"-  $ read <$> (dash |?) ->>- posInt ->>- (decimals |?) ->>- (expn |?) where+readInt :: Text -> Int+readInt = read . unpack -  decimals = dot ->>- (digit |+)-  expn      = oneOf ['e', 'E'] ->>- int+readDouble :: Text -> Double+readDouble = read . unpack

@@ -1,100 +0,0 @@-module Bookhound.Parsers.String where--import Bookhound.Parser            (Parser, char)-import Bookhound.ParserCombinators (IsMatch (..), maybeWithin, maybeWithinBoth,-                                    within, withinBoth, (->>-), (|*), (|+),-                                    (|?))-import Bookhound.Parsers.Char      (alpha, alphaNum, closeAngle, closeCurly,-                                    closeParens, closeSquare, digit,-                                    doubleQuote, letter, lower, newLine,-                                    openAngle, openCurly, openParens,-                                    openSquare, quote, space, spaceOrTab, tab,-                                    upper, whiteSpace)---string :: Parser String-string = (char |*)--word :: Parser String-word = (inverse whiteSpace |+)--digits :: Parser String-digits = (digit |+)--uppers :: Parser String-uppers = (upper |+)--lowers :: Parser String-lowers = (lower |+)--letters :: Parser String-letters = (letter |+)--alphas :: Parser String-alphas = (alpha |+)--alphaNums :: Parser String-alphaNums = (alphaNum |+)----spaces :: Parser String-spaces = (space |+)--tabs :: Parser String-tabs = (tab |+)--newLines :: Parser String-newLines = (newLine |+)--spacesOrTabs :: Parser String-spacesOrTabs = (spaceOrTab |+)--spacing :: Parser String-spacing = (whiteSpace |+)--blankLine :: Parser String-blankLine = (spacesOrTabs |?) ->>- newLine--blankLines :: Parser String-blankLines = mconcat <$> (blankLine |+)----withinQuotes :: Parser b -> Parser b-withinQuotes = within quote--withinDoubleQuotes :: Parser b -> Parser b-withinDoubleQuotes = within doubleQuote--withinParens :: Parser b -> Parser b-withinParens = withinBoth openParens closeParens--withinSquareBrackets :: Parser b -> Parser b-withinSquareBrackets = withinBoth openSquare closeSquare--withinCurlyBrackets :: Parser b -> Parser b-withinCurlyBrackets = withinBoth openCurly closeCurly--withinAngleBrackets :: Parser b -> Parser b-withinAngleBrackets = withinBoth openAngle closeAngle----maybeWithinQuotes :: Parser b -> Parser b-maybeWithinQuotes = maybeWithin quote--maybeWithinDoubleQuotes :: Parser b -> Parser b-maybeWithinDoubleQuotes = maybeWithin doubleQuote--maybeWithinParens :: Parser b -> Parser b-maybeWithinParens = maybeWithinBoth openParens closeParens--maybeWithinSquareBrackets :: Parser b -> Parser b-maybeWithinSquareBrackets = maybeWithinBoth openSquare closeSquare--maybeWithinCurlyBrackets :: Parser b -> Parser b-maybeWithinCurlyBrackets = maybeWithinBoth openCurly closeCurly--maybeWithinAngleBrackets :: Parser b -> Parser b-maybeWithinAngleBrackets = maybeWithinBoth openAngle closeAngle

@@ -0,0 +1,107 @@+module Bookhound.Parsers.Text where++import           Bookhound.Parser            (Parser, anyChar)+import           Bookhound.ParserCombinators (IsMatch (..), between,+                                              maybeBetween, maybeSurroundedBy,+                                              surroundedBy, (->>-), (|+), (|?),+                                              (||*), (||+))+import           Bookhound.Parsers.Char      (alpha, alphaNum, closeAngle,+                                              closeCurly, closeParens,+                                              closeSquare, digit, doubleQuote,+                                              lower, newLine, openAngle,+                                              openCurly, openParens, openSquare,+                                              quote, space, spaceOrTab, tab,+                                              upper, whiteSpace)+import           Data.Text                   (Text)+import qualified Data.Text                   as Text+++string :: Parser Text+string = (anyChar ||*)++word :: Parser Text+word = (inverse whiteSpace ||+)++digits :: Parser Text+digits = (digit ||+)++uppers :: Parser Text+uppers = (upper ||+)++lowers :: Parser Text+lowers = (lower ||+)++alphas :: Parser Text+alphas = (alpha ||+)++alphaNums :: Parser Text+alphaNums = (alphaNum ||+)++++spaces :: Parser Text+spaces = (space ||+)++tabs :: Parser Text+tabs = (tab ||+)++newLines :: Parser Text+newLines = (newLine ||+)++spacesOrTabs :: Parser Text+spacesOrTabs = (spaceOrTab ||+)++spacing :: Parser Text+spacing = (whiteSpace ||+)++blankLine :: Parser Text+blankLine = (spacesOrTabs |?) ->>- newLine++blankLines :: Parser Text+blankLines = fmap Text.concat (blankLine |+)++++betweenQuotes :: Parser b -> Parser b+betweenQuotes = surroundedBy quote++betweenDoubleQuotes :: Parser b -> Parser b+betweenDoubleQuotes = surroundedBy doubleQuote++betweenSpacing :: Parser b -> Parser b+betweenSpacing = surroundedBy spacing++betweenParens :: Parser b -> Parser b+betweenParens = between openParens closeParens++betweenSquare :: Parser b -> Parser b+betweenSquare = between openSquare closeSquare++betweenCurlyBrackets :: Parser b -> Parser b+betweenCurlyBrackets = between openCurly closeCurly++betweenAngleBrackets :: Parser b -> Parser b+betweenAngleBrackets = between openAngle closeAngle++++maybeBetweenQuotes :: Parser b -> Parser b+maybeBetweenQuotes = maybeSurroundedBy quote++maybeBetweenDoubleQuotes :: Parser b -> Parser b+maybeBetweenDoubleQuotes = maybeSurroundedBy doubleQuote++maybeBetweenSpacing :: Parser b -> Parser b+maybeBetweenSpacing = maybeSurroundedBy spacing++maybeBetweenParens :: Parser b -> Parser b+maybeBetweenParens = maybeBetween openParens closeParens++maybeBetweenSquareBrackets :: Parser b -> Parser b+maybeBetweenSquareBrackets = maybeBetween openSquare closeSquare++maybeBetweenCurlyBrackets :: Parser b -> Parser b+maybeBetweenCurlyBrackets = maybeBetween openCurly closeCurly++maybeBetweenAngleBrackets :: Parser b -> Parser b+maybeBetweenAngleBrackets = maybeBetween openAngle closeAngle

@@ -1,5 +0,0 @@-module Bookhound.Utils.Applicative where---extract :: Applicative m => m a1 -> m a2 -> m b -> m b-extract start end inner = start *> inner <* end

@@ -1,20 +1,10 @@ module Bookhound.Utils.Foldable where -import Bookhound.Utils.String (indent)-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-hasNone = null--hasSome :: Foldable m => m a -> Bool-hasSome = not . hasNone--hasMultiple :: Foldable m => m a -> Bool-hasMultiple xs = all hasSome $ [id, tail] <*> [toList xs]+import Bookhound.Utils.Text (indent)+import Control.Monad        (join)+import Data.Foldable        as Foldable (Foldable (toList), find)+import Data.List            (intercalate)+import Data.Maybe           (isJust)   stringify :: Foldable m => String -> String -> String -> Int -> m String -> String

@@ -1,5 +1,16 @@ module Bookhound.Utils.List where +hasNone ::  [a] -> Bool+hasNone (_ : _) = False+hasNone _       = True++hasSome :: [a] -> Bool+hasSome (_ : _) = True+hasSome _       = False++hasMultiple :: [a] -> Bool+hasMultiple (_ : _ : _) = True+hasMultiple _           = False  headSafe :: [a] -> Maybe a headSafe (x: _) = Just x

@@ -1,36 +0,0 @@-module Bookhound.Utils.String where--import Data.List (intercalate)-import Data.Text (Text, unpack)---class ToString a where-  toString :: a -> String--instance ToString Char where-  toString = pure--instance ToString Int where-  toString = show--instance ToString Text where-  toString = unpack--instance ToString Integer where-  toString = show--instance ToString Float where-  toString = show--instance ToString Double where-  toString = show--instance (ToString a, Foldable m) => ToString (m a) where-  toString = concatMap toString----indent :: Int -> String -> String-indent n str = intercalate "\n" $ indentLine <$> lines str-  where-    indentLine = (concat (replicate n " ") <>)

@@ -0,0 +1,40 @@+module Bookhound.Utils.Text where++import qualified Data.Foldable as Foldable+import           Data.List     (intercalate)+import           Data.Text     (Text, pack)+import qualified Data.Text     as Text+++class ToText a where+  toText :: a -> Text++instance ToText Char where+  toText = Text.singleton++instance ToText Int where+  toText = pack . show++instance ToText Text where+  toText = id++instance ToText Integer where+  toText = pack . show++instance ToText Float where+  toText = pack .show++instance ToText Double where+  toText = pack . show++instance ToText a => ToText [a] where+  toText = Text.concat . fmap toText++instance (ToText a, Foldable f, Functor f) => ToText (f a) where+  toText = Text.concat . Foldable.toList . fmap toText+++indent :: Int -> String -> String+indent n str = intercalate "\n" $ indentLine <$> lines str+  where+    indentLine = (concat (replicate n " ") <>)

@@ -7,9 +7,11 @@ import           Bookhound.Parser import           Bookhound.ParserCombinators import           Bookhound.Utils.List        (headSafe)+import           Control.Applicative         (optional) import qualified Data.Foldable               as Foldable-import           Data.Text                   (Text, unpack)+import           Data.Text                   (Text, pack, unpack) import qualified Data.Text                   as Text+import           Test.QuickCheck.Property    ((===))  spec :: Spec spec = do@@ -17,114 +19,108 @@   describe "times" $      prop "applies a parser n times sequentially" $-      \x n -> parse (times n char) x-          `shouldBe`-            if length (unpack x) >= n then+      \x n -> parse (times n anyChar) x+           ===+            if Text.length x >= n then                Result (Text.drop n x) (unpack $ Text.take n x)             else               Error UnexpectedEof -  describe "maybeTimes" $+  describe "optional" $      prop "applies a parser 1 or 0 times" $-      \x -> parse (maybeTimes char) x-          `shouldBe`-           headSafe <$> parseTimes char [0, 1] x+      \x -> parse (optional anyChar) x+           ===+           (headSafe <$> parseTimes anyChar [0, 1] x) -  describe "anyTimes" $+  describe "many" $      prop "applies a parser any number of times" $-      \x -> parse (anyTimes char) x-          `shouldBe`-           parseTimes char [0 .. Text.length x] x+      \x -> parse (many anyChar) x+           ===+           parseTimes anyChar [0 .. Text.length x + 10] x  -  describe "someTimes" $+  describe "some" $      prop "applies a parser at least once" $-      \x -> parse (someTimes char) x-          `shouldBe`-           replaceError "someTimes"-                        (parseTimes char [1 .. Text.length x] x)+      \x -> parse (some anyChar) x+           ===+           parseTimes anyChar [1 .. Text.length x + 10] x -  describe "multipleTimes" $+  describe "multiple" $      prop "applies a parser at least twice" $-      \x -> parse (multipleTimes char) x-          `shouldBe`-           replaceError "multipleTimes"-                        (parseTimes char [2 .. Text.length x] x)+      \x -> parse (multiple anyChar) x+           ===+           parseTimes anyChar [2 .. Text.length x + 10] x -  describe "withinBoth" $+  describe "between" $      prop "applies a parser surrounded by 2 parsers" $       \x (y :: Char) (z :: Char) ->-        parse (withinBoth (is y) (is z) char) x-       `shouldBe`-        parse (is y *> char <* is z) x+        parse (between (is y) (is z) anyChar) x+        ===+        parse (is y *> anyChar <* is z) x -  describe "maybeWithinBoth" $+  describe "maybeBetween" $      prop "applies a parser surrounded by 2 optional parsers" $       \x (y :: Char) (z :: Char) ->-        parse (maybeWithinBoth (is y) (is z) char) x-       `shouldBe`-        parse ((is y |?) *> char <* (is z |?)) x+        parse (maybeBetween (is y) (is z) anyChar) x+        ===+        parse ((is y |?) *> anyChar <* (is z |?)) x -  describe "within" $+  describe "surroundedBy" $      prop "applies a parser surrounded by a parser" $       \x (y :: Char) ->-        parse (within (is y) char) x-       `shouldBe`-        parse (is y *> char <* is y) x+        parse (surroundedBy (is y) anyChar) x+        ===+        parse (is y *> anyChar <* is y) x -  describe "maybeWithin" $+  describe "maybeSurroundedBy" $      prop "applies a parser surrounded by a optional parsers" $       \x (y :: Char) ->-        parse (maybeWithin (is y) char) x-       `shouldBe`-        parse ((is y |?) *> char <* (is y |?)) x+        parse (maybeSurroundedBy (is y) anyChar) x+        ===+        parse ((is y |?) *> anyChar <* (is y |?)) x -  describe "anySepBy" $+  describe "manySepBy" $      prop "applies a parser separated by a parser any number of times" $       \x (y :: Char) ->-        parse (anySepBy (is y) char) x-       `shouldBe`-        parse ((<>) <$> (Foldable.toList <$> (char |?))-                    <*> ((is y *> char) |*)) x+        parse (manySepBy (is y) anyChar) x+        ===+        parse ((<>) <$> (Foldable.toList <$> (anyChar |?))+                    <*> ((is y *> anyChar) |*)) x    describe "someSepBy" $      prop "applies a parser separated by a parser at least once" $       \x (y :: Char) ->-        parse (someSepBy (is y) char) x-       `shouldBe`-        parse ((:) <$> char <*> ((is y *> char) |*)) x+        parse (someSepBy (is y) anyChar) x+        ===+        parse ((:) <$> anyChar <*> ((is y *> anyChar) |*)) x    describe "multipleSepBy" $      prop "applies a parser separated by a parser at least twice" $       \x (y :: Char) ->-        parse (multipleSepBy (is y) char) x-       `shouldBe`-        parse ((:) <$> char <*> ((is y *> char) |+)) x+        parse (multipleSepBy (is y) anyChar) x+        ===+        parse ((:) <$> anyChar <*> ((is y *> anyChar) |+)) x    describe "->>-" $ -    prop "concats results of 2 parsers that can be converted to Strings" $+    prop "concats results of 2 parsers that can be converted to Texts" $       \x (y :: Char) (z :: Char) ->         parse (is y ->>- is z) x-       `shouldBe`-        parse (is [y, z]) x+        ===+        parse (is $ pack [y, z]) x   parseTimes :: Parser a -> [Int] -> Text -> ParseResult [a] parseTimes p ns = parse $ anyOf ((`times` p) <$> reverse ns) --replaceError :: String -> ParseResult a -> ParseResult a-replaceError err (Error (NoMatch _)) = Error $ NoMatch err-replaceError _ result                = result

@@ -4,9 +4,11 @@ import Test.Hspec.QuickCheck import Test.QuickCheck.Instances.Text () +import Bookhound.Utils.List  import Bookhound.Parser import Data.Char-import Data.Text        (pack, unpack)+import Data.Text                (pack, unpack)+import Test.QuickCheck.Property ((===))   @@ -16,57 +18,57 @@   describe "Functor laws" $ do      prop "Identity" $-      \x -> parse (id <$> char) x-          `shouldBe`-           parse char x+      \x -> parse (id <$> anyChar) x+           ===+           parse anyChar x      prop "Composition" $-      \x -> parse ((isLower . toUpper) <$> char) x-          `shouldBe`-           parse ((isLower <$>) . (toUpper <$>) $ char) x+      \x -> parse ((isLower . toUpper) <$> anyChar) x+           ===+           parse ((isLower <$>) . (toUpper <$>) $ anyChar) x     describe "Applicative laws" $ do      prop "Identity" $-      \x -> parse (pure id <*> char) x-          `shouldBe`-           parse char x+      \x -> parse (pure id <*> anyChar) x+           ===+           parse anyChar x      prop "Homomorphism" $       \x (y :: [Int]) -> parse (pure sum <*> pure y) x-          `shouldBe`+           ===            parse (pure (sum y)) x      prop "Interchange" $       \x (y :: [Int])  -> parse (pure length <*> pure y) x-          `shouldBe`+           ===            parse (pure ($ y) <*> pure length) x     describe "Monad laws" $ do      prop "Left identity" $-      \x -> parse (pure 'a' >>= isMatch (==) char) x-          `shouldBe`-           parse (isMatch (==) char 'a') x+      \x -> parse (pure 'a' >>= isMatch (==) anyChar) x+           ===+           parse (isMatch (==) anyChar 'a') x      prop "Right identity" $-      \x -> parse (char >>= pure) x-          `shouldBe`-           parse char x+      \x -> parse (anyChar >>= pure) x+           ===+           parse anyChar x      prop "Associativity" $       \x -> parse-           (char >>= (\y -> isMatch (<) char y >>= isMatch (>) char)) x-          `shouldBe`-           parse ((char >>= isMatch (<) char) >>= isMatch (>) char) x+           (anyChar >>= (\y -> isMatch (<) anyChar y >>= isMatch (>) anyChar)) x+           ===+           parse ((anyChar >>= isMatch (<) anyChar) >>= isMatch (>) anyChar) x -  describe "char" $+  describe "anyChar" $ -    prop "parses a single char" $-      \x -> parse char x-          `shouldBe`+    prop "parses a single anyChar" $+      \x -> parse anyChar x+           ===            case unpack x of              (ch : rest) -> Result (pack rest) ch              []          -> Error UnexpectedEof@@ -74,54 +76,54 @@   describe "isMatch" $ do      prop "works for ==" $-      \x y -> parse (isMatch (==) char y) x-            `shouldBe`+      \x y -> parse (isMatch (==) anyChar y) x+             ===              case unpack x of                (ch : rest)                  | ch == y    -> Result (pack rest) ch-                 | otherwise -> Error $ UnexpectedChar ch-               []            -> Error UnexpectedEof+                 | hasSome rest -> Error $ ExpectedEof $ pack rest+               _            -> Error UnexpectedEof      prop "works for /=" $-      \x y -> parse (isMatch (/=) char y) x-            `shouldBe`+      \x y -> parse (isMatch (/=) anyChar y) x+             ===              case unpack x of                (ch : rest)                  | ch /= y    -> Result (pack rest) ch-                 | otherwise -> Error $ UnexpectedChar ch-               []            -> Error UnexpectedEof+                 | hasSome rest -> Error $ ExpectedEof $ pack rest+               _            -> Error UnexpectedEof -  describe "check" $+  describe "satisfy" $      prop "performs a check on the parse result" $-      \x -> parse (check "digit" isDigit char) x-          `shouldBe`+      \x -> parse (satisfy isDigit anyChar) x+           ===            case unpack x of              (ch : rest)                | isDigit ch -> Result (pack rest) ch-               | otherwise  -> Error $ NoMatch "digit"-             []             -> Error UnexpectedEof+               | hasSome rest -> Error $ ExpectedEof $ pack rest+             _             -> Error UnexpectedEof    describe "except" $      context "when the second parser fails" $       prop "the first parser then runs" $-        \x -> parse (except char (char *> char)) x-            `shouldBe`+        \x -> parse (except anyChar (anyChar *> anyChar)) x+             ===              case unpack x of                [ch]    -> Result (pack "") ch-               (_ : _) -> Error $ NoMatch "except"+               (_ : _) -> Error $ ExpectedEof x                []      -> Error UnexpectedEof    describe "anyOf" $      prop "returns first parser success or last parser error if all fail" $-      \x -> parse (anyOf [errorParser $ ErrorAt "firstError",-                         "firstSuccess"  <$ char,-                         "secondSuccess" <$ char,-                         errorParser $ ErrorAt "secondError",-                         errorParser $ ErrorAt "lastError"]) x-          `shouldBe`+      \x -> parse (anyOf [throwError $ ErrorAt "firstError",+                         "firstSuccess"  <$ anyChar,+                         "secondSuccess" <$ anyChar,+                         throwError $ ErrorAt "secondError",+                         throwError $ ErrorAt "lastError"]) x+           ===            case unpack x of              (_ : rest) -> Result (pack rest) "firstSuccess"              []         -> Error $ ErrorAt "lastError"@@ -130,20 +132,20 @@      context "when any parser fails" $       prop "returns first parser error" $-        \x -> parse (allOf ["firstSuccess"  <$ char,-                           "secondSuccess" <$ char,-                           errorParser $ ErrorAt "firstError"]) x-            `shouldBe`+        \x -> parse (allOf ["firstSuccess"  <$ anyChar,+                           "secondSuccess" <$ anyChar,+                           throwError $ ErrorAt "firstError"]) x+             ===              case unpack x of                (_ : _) -> Error $ ErrorAt "firstError"                []      -> Error UnexpectedEof      context "when all parsers succeed" $       prop "returns last parser success" $-        \x -> parse (allOf ["firstSuccess"  <$ char,-                           "secondSuccess" <$ char,-                           "thirdSuccess"  <$ char]) x-            `shouldBe`+        \x -> parse (allOf ["firstSuccess"  <$ anyChar,+                           "secondSuccess" <$ anyChar,+                           "thirdSuccess"  <$ anyChar]) x+             ===              case unpack x of                (_ : rest) -> Result (pack rest) "thirdSuccess"                []         -> Error UnexpectedEof@@ -151,8 +153,8 @@   describe "exactly" $      prop "returns an error when some chars remain after parsing" $-      \x -> parse (exactly char) x-          `shouldBe`+      \x -> parse (exactly anyChar) x+           ===            case unpack x of              [ch]       -> Result (pack []) ch              (_ : rest) -> Error $ ExpectedEof (pack rest)@@ -161,35 +163,36 @@   describe "runParser" $      prop "parses exactly and wraps the result into an either" $-      \x -> runParser char x-          `shouldBe`-           toEither (parse (exactly char) x)+      \x -> runParser anyChar x+           ===+           toEither (parse (exactly anyChar) x)     describe "withError" $      prop "includes error labels in order when running the parser" $-      \x -> runParser ((,) <$> withErrorN 2 "firstErr" char-                          <*> withErrorN 1 "secondErr" char) x-          `shouldBe`-             case unpack x of-               [ch1, ch2] -> Right (ch1, ch2)-               (_ : _ : rest)   -> Left [ErrorAt "firstErr",-                                        ErrorAt "secondErr",-                                        ExpectedEof (pack rest)]-               _                -> Left [ErrorAt "firstErr",-                                        ErrorAt "secondErr",-                                        UnexpectedEof]+      \x -> runParser ((,) <$> withErrorN 2 "firstErr" anyChar+                          <*> withErrorN 1 "secondErr" anyChar) x+           ===+           case unpack x of+             [ch1, ch2] -> Right (ch1, ch2)+             (_ : _ : rest)   -> Left [ErrorAt "firstErr",+                                      ErrorAt "secondErr",+                                      ExpectedEof (pack rest)]+             _                -> Left [ErrorAt "firstErr",+                                      ErrorAt "secondErr",+                                      UnexpectedEof]    describe "withTransform" $      prop "transforms current parser with provided fn" $-      \x -> parse (withTransform (\p -> char *> p <* char) char) x-          `shouldBe`-           parse (char *> char <* char) x-+      \x -> parse (withTransform (\p -> anyChar *> p <* anyChar) anyChar) x+           ===+           parse (anyChar *> anyChar <* anyChar) x  +isMatch :: (a -> a -> Bool) -> Parser a -> a -> Parser a+isMatch cond ma c1 = satisfy (cond c1) ma  toEither :: ParseResult a -> Either [ParseError] a toEither = \case

@@ -11,8 +11,9 @@ import           Data.Char                     (isAlpha, isAscii) import           Data.List                     (intercalate) import qualified Data.Map                      as Map-import           Data.Text                     (pack)+import           Data.Text                     ( pack) import           Test.QuickCheck               ((==>))+import           Test.QuickCheck.Property      ((===))   @@ -27,7 +28,7 @@         (pack ("[" <>                intercalate ", " (pure <$> filter isAlpha' x)                <> "]"))-       `shouldBe`+        ===         Right (filter isAlpha' x)    describe "tupleOf" $@@ -38,24 +39,24 @@         (pack ("(" <>                intercalate ", " (pure <$> filter isAlpha' x)                <> ")"))-       `shouldBe`+        ===         Right (filter isAlpha' x)    describe "mapOf" $      prop "parses a map provided the key and value parsers" $       \(x :: [(Char, Char)]) ->-        runParser (mapOf (is "->") alpha alpha)+        runParser (mapOf (is (":" :: String)) alpha alpha)         (pack ("{" <>                intercalate ", " (showMapEntry <$> filter areAlpha' x)                <> "}"))-       `shouldBe`-        Right (Map.fromList $ filter areAlpha' x)+        ===+        Right ( Map.fromList $ filter areAlpha' x)    showMapEntry :: (Char, Char) -> String-showMapEntry (x, y) = pure x <> " -> " <> pure y+showMapEntry (x, y) = pure x <> ": " <> pure y  areAlpha' :: (Char, Char) -> Bool areAlpha' (x, y) = isAlpha' x && isAlpha' y

@@ -9,8 +9,9 @@ import Bookhound.Parsers.DateTime import Data.Text                  (pack) -import Data.Time (Day, LocalTime, TimeOfDay, TimeZone (..), ZonedTime (..),-                  zonedTimeToUTC)+import Data.Time                (Day, LocalTime, TimeOfDay, TimeZone (..),+                                 ZonedTime (..), zonedTimeToUTC)+import Test.QuickCheck.Property ((===))   spec :: Spec@@ -21,7 +22,7 @@     prop "parses a date" $       \(x :: Day) ->         runParser date (pack $ show x)-       `shouldBe`+        ===         Right x    describe "time" $@@ -29,7 +30,7 @@     prop "parses a time" $       \(x :: TimeOfDay) ->         runParser time (pack $ show x)-       `shouldBe`+        ===         Right x    describe "timeZoneOffset" $@@ -37,7 +38,7 @@     prop "parses a timezone offset" $       \(x :: TimeZone) ->         runParser timeZoneOffset (pack $ show $ normalizeTimeZone x)-       `shouldBe`+        ===         Right (normalizeTimeZone x)    describe "localDateTime" $@@ -45,7 +46,7 @@     prop "parses a local datetime" $       \(x :: LocalTime) ->         runParser localDateTime (pack $ show x)-       `shouldBe`+        ===         Right x    describe "DateTime" $@@ -54,7 +55,7 @@       \(x :: ZonedTime) ->         (zonedTimeToUTC <$> runParser dateTime          (pack $ show $ normalizeZonedTime x))-       `shouldBe`+        ===         Right (zonedTimeToUTC $ normalizeZonedTime x)  

@@ -9,6 +9,7 @@ import Bookhound.Parser import Bookhound.Parsers.Number import Data.Text                (pack)+import Test.QuickCheck.Property ((===))   @@ -18,32 +19,24 @@   describe "posInt" $      prop "parses a positive Int" $-      \(x :: Integer) -> x > 0 ==>+      \(x :: Int) -> x > 0 ==>         runParser posInt (pack $ show x)-       `shouldBe`+        ===         Right x    describe "negInt" $      prop "parses a negative Int" $-      \(x :: Integer) -> x < 0 ==>+      \(x :: Int) -> x < 0 ==>         runParser negInt (pack $ show x)-       `shouldBe`+        ===         Right x    describe "int" $      prop "parses an Int" $-      \(x :: Integer) ->+      \(x :: Int) ->         runParser int (pack $ show x)-       `shouldBe`+        ===         Right x --  describe "double" $--    prop "parses a Double" $-      \(x :: Double) ->-        runParser double (pack $ show x)-       `shouldBe`-        Right x