bookhound 0.1.24.0 → 0.1.25.0

raw patch · 16 files changed

+648/−72 lines, 16 filesdep +QuickCheckdep +bookhounddep +hspecdep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, bookhound, hspec, quickcheck-instances

Dependency ranges changed: text

API changes (from Hackage documentation)

Files

• bookhound.cabal +61/−2
• src/Bookhound/Parser.hs +27/−26
• src/Bookhound/ParserCombinators.hs +19/−18
• src/Bookhound/Parsers/Char.hs +1/−5
• src/Bookhound/Parsers/Collections.hs +4/−3
• src/Bookhound/Parsers/DateTime.hs +9/−8
• src/Bookhound/Parsers/Number.hs +5/−4
• src/Bookhound/Parsers/String.hs +5/−4
• src/Bookhound/Utils/Foldable.hs +2/−2
• src/Bookhound/Utils/List.hs +6/−0
• test/Bookhound/ParserCombinatorsSpec.hs +130/−0
• test/Bookhound/ParserSpec.hs +197/−0
• test/Bookhound/Parsers/CollectionsSpec.hs +64/−0
• test/Bookhound/Parsers/DateTimeSpec.hs +68/−0
• test/Bookhound/Parsers/NumberSpec.hs +49/−0
• test/Spec.hs +1/−0

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           bookhound-version:        0.1.24.0+version:        0.1.25.0 synopsis:       Simple Parser Combinators description:    Please see the README on GitHub at <https://github.com/albertprz/bookhound#readme> category:       Parser Combinators@@ -36,6 +36,7 @@       Bookhound.Utils.Applicative       Bookhound.Utils.DateTime       Bookhound.Utils.Foldable+      Bookhound.Utils.List       Bookhound.Utils.Map       Bookhound.Utils.String   other-modules:@@ -78,6 +79,64 @@   build-depends:       base >=4.7 && <5     , containers >=0.6 && <1-    , text >=2.0 && <3+    , text+    , time >=1.9 && <2+  default-language: Haskell2010++test-suite test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Bookhound.ParserCombinatorsSpec+      Bookhound.Parsers.CollectionsSpec+      Bookhound.Parsers.DateTimeSpec+      Bookhound.Parsers.NumberSpec+      Bookhound.ParserSpec+      Paths_bookhound+  hs-source-dirs:+      test+  default-extensions:+      LambdaCase+      MultiWayIf+      TupleSections+      PostfixOperators+      BlockArguments+      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+  build-tool-depends:+      hspec-discover:hspec-discover+  build-depends:+      QuickCheck+    , base >=4.7 && <5+    , bookhound+    , containers >=0.6 && <1+    , hspec+    , quickcheck-instances+    , text     , time >=1.9 && <2   default-language: Haskell2010

@@ -1,4 +1,4 @@-module Bookhound.Parser (Parser, ParseResult, ParseError(..), runParser, errorParser,+module Bookhound.Parser (Parser(parse), ParseResult(..), ParseError(..), runParser, errorParser,                andThen, exactly, isMatch, check, anyOf, allOf, char,                withTransform, withError, withErrorN, except) where @@ -33,26 +33,9 @@   deriving (Eq, Ord)  -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-- instance Functor ParseResult where   fmap f (Result i a) = Result i (f a)-  fmap _ (Error pe)   = (Error pe)+  fmap _ (Error pe)   = Error pe   instance Functor Parser where@@ -64,7 +47,7 @@   liftA2 f (P p t e) mb@(P _ t' e') =     applyTransformsErrors [t, t'] [e, e'] $ mkParser (\x ->       case p x of-        Result i a -> parse ((f a) <$> mb) i+        Result i a -> parse (f a <$> mb) i         Error pe   -> Error pe     ) @@ -81,20 +64,16 @@   where     toEither = \case       Result _ a -> Right a-      Error pe   -> Left $ filter (hasPriorityError)   [pe]   <>+      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  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+  mkParser (\i -> parse p2 $ fromRight i $ pack <$> runParser p1 i)  char :: Parser Char char = mkParser $@@ -179,8 +158,25 @@ 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@@ -205,3 +201,8 @@  mkParser :: (Input -> ParseResult a) -> Parser a mkParser p = P {parse = p, transform = Nothing, errors = Set.empty}+++hasPriorityError :: ParseError -> Bool+hasPriorityError (ErrorAt _) = True+hasPriorityError _           = False

@@ -1,10 +1,12 @@ {-# 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, sepByOp,+                          anySepBy, someSepBy, multipleSepBy, sepByOps, sepByOp,                           (<|>), (<?>), (<#>), (->>-), (|?), (|*), (|+), (|++))  where  import Bookhound.Parser            (Parser, allOf, anyOf, char, check, except,@@ -13,8 +15,7 @@ import Bookhound.Utils.Foldable    (hasMultiple, hasSome) import Bookhound.Utils.String      (ToString (..)) -import Data.List  (isInfixOf)-import Data.Maybe (listToMaybe)+import Data.List (isInfixOf)  import           Data.Bifunctor (Bifunctor (first)) import qualified Data.Foldable  as Foldable@@ -49,13 +50,13 @@  -- Condition combinators satisfies :: (a -> Bool) -> Parser a -> Parser a-satisfies cond p = check "satisfies" cond p+satisfies = check "satisfies"  contains :: Eq a => [a] -> Parser [a] -> Parser [a]-contains val p = check "contains" (isInfixOf val) p+contains val = check "contains" (isInfixOf val)  notContains :: Eq a => [a] -> Parser [a] -> Parser [a]-notContains val p = check "notContains" (isInfixOf val) p+notContains val = check "notContains" (isInfixOf val)  containsAnyOf :: (Foldable t, Eq a) => t [a] -> Parser [a] -> Parser [a] containsAnyOf x y = foldr contains y x@@ -65,15 +66,15 @@    -- Frequency combinators-times :: Integer -> Parser a  -> Parser [a]+times :: Int -> Parser a  -> Parser [a] times n p = sequence $ p <$ [1 .. n]   maybeTimes :: Parser a -> Parser (Maybe a)-maybeTimes = (listToMaybe <$>) . check "maybeTimes" (not . hasMultiple) . anyTimes+maybeTimes p = Just <$> p <|> pure Nothing  anyTimes :: Parser a -> Parser [a]-anyTimes parser = (parser >>= \x -> (x :) <$> anyTimes parser) <|> pure []+anyTimes p = (p >>= \x -> (x :) <$> anyTimes p) <|> pure []  someTimes :: Parser a -> Parser [a] someTimes = check "someTimes" hasSome . anyTimes@@ -83,19 +84,19 @@   -- Within combinators-within :: Parser a -> Parser b -> Parser b-within p = extract p p--maybeWithin :: Parser a -> Parser b -> Parser b-maybeWithin p = within (p |?)- withinBoth :: Parser a -> Parser b -> Parser c -> Parser c withinBoth = extract  maybeWithinBoth :: Parser a -> Parser b -> Parser c -> Parser c-maybeWithinBoth p1 p2 = extract (p1 |?) (p2 |?)+maybeWithinBoth p1 p2 = withinBoth (p1 |?) (p2 |?) +within :: Parser a -> Parser b -> Parser b+within p = withinBoth p p +maybeWithin :: Parser a -> Parser b -> Parser b+maybeWithin p = within (p |?)++ -- Separated by combinators sepBy :: (Parser b -> Parser (Maybe b)) -> (Parser b -> Parser [b])                 -> Parser a -> Parser b -> Parser [b]@@ -114,7 +115,7 @@ sepByOps :: Parser a -> Parser b -> Parser ([a], [b]) sepByOps sep p = do x <-  p                     y <- (((,) <$> sep <*> p) |+)-                    pure $ (fst <$> y, x : (snd <$> y))+                    pure (fst <$> y, x : (snd <$> y))  sepByOp :: Parser a -> Parser b -> Parser (a, [b]) sepByOp sep p = first head <$> sepByOps sep p@@ -126,7 +127,7 @@ (<|>) p1 p2 = anyOf [p1, p2]  infixl 6 <#>-(<#>) :: Parser a -> Integer -> Parser [a]+(<#>) :: Parser a -> Int -> Parser [a] (<#>) = flip times  infixl 6 <?>

@@ -2,12 +2,8 @@  import Bookhound.ParserCombinators (IsMatch (..), (<|>)) -import           Bookhound.Parser (Parser)-import qualified Bookhound.Parser as Parser-+import Bookhound.Parser (Parser) -char :: Parser Char-char = Parser.char  digit :: Parser Char digit = oneOf ['0' .. '9']

@@ -6,8 +6,9 @@                                     openCurly, openParens, openSquare) import Bookhound.Parsers.String    (spacing) -import           Data.Map (Map)-import qualified Data.Map as Map+import           Bookhound.Utils.Foldable (hasMultiple)+import           Data.Map                 (Map)+import qualified Data.Map                 as Map   collOf :: Parser a -> Parser b -> Parser c -> Parser d -> Parser [d]@@ -24,7 +25,7 @@  tupleOf :: Parser a -> Parser [a] tupleOf = withErrorN (-1) "Tuple"-  . satisfies ((>= 2) . length)+  . satisfies hasMultiple   . collOf openParens closeParens comma  

@@ -3,13 +3,14 @@ import Bookhound.Parser            (Parser, check, withErrorN) import Bookhound.ParserCombinators (IsMatch (..), within, (<#>), (<|>), (|+),                                     (|?))-import Bookhound.Parsers.Char      (colon, dash, digit, plus)+import Bookhound.Parsers.Char      (colon, dash, digit, dot, plus)  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@@ -20,26 +21,26 @@   do h <- hour      m <- colon *> minute      s <- colon *> second-     decimals <- fromMaybe 0 <$> ((colon *> secondDecimals) |?)-     pure $ TimeOfDay h m $ read (show s <> "." <> show decimals)+     decimals <- ((dot *> secondDecimals) |?)+     pure $ TimeOfDay h m $ read (show s <> foldMap ("." ++) decimals)   timeZoneOffset :: Parser TimeZone timeZoneOffset = withErrorN (-1) "Timezone Offset" $   do pos <- (True <$ plus) <|> (False <$ dash)      h <- hour-     m <- fromMaybe 0 <$> ((colon *> minute) |?)+     m <- fromMaybe 0 <$> (minute |?)      pure $ minutesToTimeZone $ (if pos then 1 else (-1)) * (h * 60 + m)   localDateTime :: Parser LocalTime localDateTime = withErrorN (-1) "Local DateTime" $-  LocalTime <$> (date <* oneOf ['T', 't']) <*> time+  LocalTime <$> (date <* oneOf ['T', 't', ' ']) <*> time   offsetDateTime :: Parser ZonedTime offsetDateTime = withErrorN (-1) "Offset DateTime" $-  ZonedTime <$> localDateTime <*> timeZoneOffset+  ZonedTime <$> localDateTime <*> (is ' ' *> timeZoneOffset)   dateTime :: Parser ZonedTime@@ -67,8 +68,8 @@ second :: Parser Int second = check "Second" (range 0 59) $ read <$> digit <#> 2 -secondDecimals :: Parser Integer-secondDecimals = read <$> check "Pico Seconds" ((<= 12) . length) (digit |+)+secondDecimals :: Parser String+secondDecimals = check "Pico Seconds" ((<= 12) . length) (digit |+)   

@@ -21,14 +21,15 @@  posInt :: Parser Integer posInt = withErrorN (-1) "Positive Int"-  $ read <$> (plus |?) ->>- (digit |+)+  $ read <$> ((plus |?) *> (digit |+))  negInt :: Parser Integer negInt = withErrorN (-1) "Negative Int"   $ read <$> dash ->>- (digit |+)  int :: Parser Integer-int = withErrorN (-1) "Int" $ negInt <|> posInt+int = withErrorN (-1) "Int"+  $ negInt <|> posInt  intLike :: Parser Integer intLike = parser <|> int@@ -45,7 +46,7 @@  double :: Parser Double double = withErrorN (-1) "Double"-  $ read <$> int ->>- (decimals |?) ->>- (expn |?) where+  $ read <$> (dash |?) ->>- posInt ->>- (decimals |?) ->>- (expn |?) where -  decimals = dot ->>- unsignedInt+  decimals = dot ->>- (digit |+)   expn      = oneOf ['e', 'E'] ->>- int

@@ -1,10 +1,11 @@ module Bookhound.Parsers.String where -import Bookhound.Parser            (Parser)+import Bookhound.Parser            (Parser, char) import Bookhound.ParserCombinators (IsMatch (..), maybeWithin, maybeWithinBoth,-                                    within, withinBoth, (->>-), (|*), (|+), (|?))-import Bookhound.Parsers.Char      (alpha, alphaNum, char, closeAngle,-                                    closeCurly, closeParens, closeSquare, digit,+                                    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,

@@ -14,10 +14,10 @@ hasSome = not . hasNone  hasMultiple :: Foldable m => m a -> Bool-hasMultiple xs = all hasSome $ [id, tail] <*> [Foldable.toList xs]+hasMultiple xs = all hasSome $ [id, tail] <*> [toList xs]  -stringify :: (Foldable m) => String -> String -> String -> Int -> m String -> String+stringify :: Foldable m => String -> String -> String -> Int -> m String -> String stringify sep start end n xs = start <> indent n str <> end   where     str = intercalate sep list

@@ -0,0 +1,6 @@+module Bookhound.Utils.List where+++headSafe :: [a] -> Maybe a+headSafe (x: _) = Just x+headSafe _      = Nothing

@@ -0,0 +1,130 @@+module Bookhound.ParserCombinatorsSpec where++import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck.Instances.Text ()++import           Bookhound.Parser+import           Bookhound.ParserCombinators+import           Bookhound.Utils.List        (headSafe)+import qualified Data.Foldable               as Foldable+import           Data.Text                   (Text, unpack)+import qualified Data.Text                   as Text++spec :: Spec+spec = do++  describe "times" $++    prop "applies a parser n times sequentially" $+      \x n -> parse (times n char) x+          `shouldBe`+            if length (unpack x) >= n then+               Result (Text.drop n x) (unpack $ Text.take n x)+            else+              Error UnexpectedEof++  describe "maybeTimes" $++    prop "applies a parser 1 or 0 times" $+      \x -> parse (maybeTimes char) x+          `shouldBe`+           headSafe <$> parseTimes char [0, 1] x++  describe "anyTimes" $++    prop "applies a parser any number of times" $+      \x -> parse (anyTimes char) x+          `shouldBe`+           parseTimes char [0 .. Text.length x] x+++  describe "someTimes" $++    prop "applies a parser at least once" $+      \x -> parse (someTimes char) x+          `shouldBe`+           replaceError "someTimes"+                        (parseTimes char [1 .. Text.length x] x)++  describe "multipleTimes" $++    prop "applies a parser at least twice" $+      \x -> parse (multipleTimes char) x+          `shouldBe`+           replaceError "multipleTimes"+                        (parseTimes char [2 .. Text.length x] x)++  describe "withinBoth" $++    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++  describe "maybeWithinBoth" $++    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++  describe "within" $++    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++  describe "maybeWithin" $++    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++  describe "anySepBy" $++    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++  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++  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++  describe "->>-" $++    prop "concats results of 2 parsers that can be converted to Strings" $+      \x (y :: Char) (z :: Char) ->+        parse (is y ->>- is z) x+       `shouldBe`+        parse (is [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

@@ -0,0 +1,197 @@+module Bookhound.ParserSpec where++import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck.Instances.Text ()++import Bookhound.Parser+import Data.Char+import Data.Text        (pack, unpack)++++spec :: Spec+spec = do++  describe "Functor laws" $ do++    prop "Identity" $+      \x -> parse (id <$> char) x+          `shouldBe`+           parse char x++    prop "Composition" $+      \x -> parse ((isLower . toUpper) <$> char) x+          `shouldBe`+           parse ((isLower <$>) . (toUpper <$>) $ char) x+++  describe "Applicative laws" $ do++    prop "Identity" $+      \x -> parse (pure id <*> char) x+          `shouldBe`+           parse char 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++    prop "Right identity" $+      \x -> parse (char >>= pure) x+          `shouldBe`+           parse char x++    prop "Associativity" $+      \x -> parse+           (char >>= (\y -> isMatch (<) char y >>= isMatch (>) char)) x+          `shouldBe`+           parse ((char >>= isMatch (<) char) >>= isMatch (>) char) x++  describe "char" $++    prop "parses a single char" $+      \x -> parse char x+          `shouldBe`+           case unpack x of+             (ch : rest) -> Result (pack rest) ch+             []          -> Error UnexpectedEof++  describe "isMatch" $ do++    prop "works for ==" $+      \x y -> parse (isMatch (==) char y) x+            `shouldBe`+             case unpack x of+               (ch : rest)+                 | ch == y    -> Result (pack rest) ch+                 | otherwise -> Error $ UnexpectedChar ch+               []            -> Error UnexpectedEof++    prop "works for /=" $+      \x y -> parse (isMatch (/=) char y) x+            `shouldBe`+             case unpack x of+               (ch : rest)+                 | ch /= y    -> Result (pack rest) ch+                 | otherwise -> Error $ UnexpectedChar ch+               []            -> Error UnexpectedEof++  describe "check" $++    prop "performs a check on the parse result" $+      \x -> parse (check "digit" isDigit char) x+          `shouldBe`+           case unpack x of+             (ch : rest)+               | isDigit ch -> Result (pack rest) ch+               | otherwise  -> Error $ NoMatch "digit"+             []             -> Error UnexpectedEof++  describe "except" $++    context "when the second parser fails" $+      prop "the first parser then runs" $+        \x -> parse (except char (char *> char)) x+            `shouldBe`+             case unpack x of+               [ch]    -> Result (pack "") ch+               (_ : _) -> Error $ NoMatch "except"+               []      -> 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`+           case unpack x of+             (_ : rest) -> Result (pack rest) "firstSuccess"+             []         -> Error $ ErrorAt "lastError"++  describe "allOf" $ do++    context "when any parser fails" $+      prop "returns first parser error" $+        \x -> parse (allOf ["firstSuccess"  <$ char,+                           "secondSuccess" <$ char,+                           errorParser $ ErrorAt "firstError"]) x+            `shouldBe`+             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`+             case unpack x of+               (_ : rest) -> Result (pack rest) "thirdSuccess"+               []         -> Error UnexpectedEof++  describe "exactly" $++    prop "returns an error when some chars remain after parsing" $+      \x -> parse (exactly char) x+          `shouldBe`+           case unpack x of+             [ch]       -> Result (pack []) ch+             (_ : rest) -> Error $ ExpectedEof (pack rest)+             []         -> Error UnexpectedEof++  describe "runParser" $++    prop "parses exactly and wraps the result into an either" $+      \x -> runParser char x+          `shouldBe`+           toEither (parse (exactly char) 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]++  describe "withTransform" $++    prop "transforms current parser with provided fn" $+      \x -> parse (withTransform (\p -> char *> p <* char) char) x+          `shouldBe`+           parse (char *> char <* char) x+++++toEither :: ParseResult a -> Either [ParseError] a+toEither = \case+  Result _ a -> Right a+  Error pe   -> Left [pe]

@@ -0,0 +1,64 @@+module Bookhound.Parsers.CollectionsSpec where++import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck.Instances.Text ()++import           Bookhound.Parser+import           Bookhound.ParserCombinators   (IsMatch (is))+import           Bookhound.Parsers.Char        (alpha)+import           Bookhound.Parsers.Collections+import           Data.Char                     (isAlpha, isAscii)+import           Data.List                     (intercalate)+import qualified Data.Map                      as Map+import           Data.Text                     (pack)+import           Test.QuickCheck               ((==>))++++spec :: Spec+spec = do++  describe "listOf" $++    prop "parses a list provided the element parser" $+      \(x :: [Char]) ->+        runParser (listOf alpha)+        (pack ("[" <>+               intercalate ", " (pure <$> filter isAlpha' x)+               <> "]"))+       `shouldBe`+        Right (filter isAlpha' x)++  describe "tupleOf" $++    prop "parses a tuple provided the element parser" $+      \(x :: [Char]) -> length (filter isAlpha' x) >= 2 ==>+        runParser (tupleOf alpha)+        (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)+        (pack ("{" <>+               intercalate ", " (showMapEntry <$> filter areAlpha' x)+               <> "}"))+       `shouldBe`+        Right (Map.fromList $ filter areAlpha' x)++++showMapEntry :: (Char, Char) -> String+showMapEntry (x, y) = pure x <> " -> " <> pure y++areAlpha' :: (Char, Char) -> Bool+areAlpha' (x, y) = isAlpha' x && isAlpha' y++isAlpha' :: Char -> Bool+isAlpha' x = isAlpha x && isAscii x

@@ -0,0 +1,68 @@+module Bookhound.Parsers.DateTimeSpec where++import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck.Instances.Text ()+import Test.QuickCheck.Instances.Time ()++import Bookhound.Parser+import Bookhound.Parsers.DateTime+import Data.Text                  (pack)++import Data.Time (Day, LocalTime, TimeOfDay, TimeZone (..), ZonedTime (..),+                  zonedTimeToUTC)+++spec :: Spec+spec = do++  describe "date" $++    prop "parses a date" $+      \(x :: Day) ->+        runParser date (pack $ show x)+       `shouldBe`+        Right x++  describe "time" $++    prop "parses a time" $+      \(x :: TimeOfDay) ->+        runParser time (pack $ show x)+       `shouldBe`+        Right x++  describe "timeZoneOffset" $++    prop "parses a timezone offset" $+      \(x :: TimeZone) ->+        runParser timeZoneOffset (pack $ show $ normalizeTimeZone x)+       `shouldBe`+        Right (normalizeTimeZone x)++  describe "localDateTime" $++    prop "parses a local datetime" $+      \(x :: LocalTime) ->+        runParser localDateTime (pack $ show x)+       `shouldBe`+        Right x++  describe "DateTime" $++    prop "parses a datetime" $+      \(x :: ZonedTime) ->+        (zonedTimeToUTC <$> runParser dateTime+         (pack $ show $ normalizeZonedTime x))+       `shouldBe`+        Right (zonedTimeToUTC $ normalizeZonedTime x)++++normalizeTimeZone :: TimeZone -> TimeZone+normalizeTimeZone z =+  z {timeZoneName = "", timeZoneSummerOnly = False}++normalizeZonedTime :: ZonedTime -> ZonedTime+normalizeZonedTime t@(ZonedTime {zonedTimeZone = x}) =+  t {zonedTimeZone = normalizeTimeZone x}

@@ -0,0 +1,49 @@+module Bookhound.Parsers.NumberSpec where++import Test.Hspec+import Test.Hspec.QuickCheck++import Test.QuickCheck                ((==>))+import Test.QuickCheck.Instances.Text ()++import Bookhound.Parser+import Bookhound.Parsers.Number+import Data.Text                (pack)++++spec :: Spec+spec = do++  describe "posInt" $++    prop "parses a positive Int" $+      \(x :: Integer) -> x > 0 ==>+        runParser posInt (pack $ show x)+       `shouldBe`+        Right x++  describe "negInt" $++    prop "parses a negative Int" $+      \(x :: Integer) -> x < 0 ==>+        runParser negInt (pack $ show x)+       `shouldBe`+        Right x++  describe "int" $++    prop "parses an Int" $+      \(x :: Integer) ->+        runParser int (pack $ show x)+       `shouldBe`+        Right x+++  describe "double" $++    prop "parses a Double" $+      \(x :: Double) ->+        runParser double (pack $ show x)+       `shouldBe`+        Right x

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}