packages feed

yaml-combinators 1.0 → 1.0.1

raw patch · 5 files changed

+94/−24 lines, 5 filesdep ~basedep ~generics-sop

Dependency ranges changed: base, generics-sop

Files

ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for yaml-combinators +## 1.0.1 — 2017-06-13++* Add `validate`+ ## 1.0 — 2017-03-03  * First version. Released on an unsuspecting world.
+ README.md view
@@ -0,0 +1,1 @@+[Better YAML Parsing](https://ro-che.info/articles/2015-07-26-better-yaml-parsing)
src/Data/Yaml/Combinators.hs view
@@ -3,7 +3,7 @@ -- Based on the article <https://ro-che.info/articles/2015-07-26-better-yaml-parsing Better Yaml Parsing>. {-# LANGUAGE PolyKinds, DataKinds, KindSignatures,              ExplicitForAll, TemplateHaskell, ViewPatterns,-             TypeOperators, TypeFamilies,+             ScopedTypeVariables, TypeOperators, TypeFamilies,              GeneralizedNewtypeDeriving #-} module Data.Yaml.Combinators   ( Parser@@ -25,10 +25,12 @@   , FieldParser   , field   , optField+  , defaultField   , theField   -- * Errors   , ParseError(..)   , Reason(..)+  , validate   ) where  import Data.Aeson (Value(..), Object, Array)@@ -122,7 +124,7 @@ --                           Core definitions ---------------------------------------------------------------------- -newtype ParserComponent a fs = ParserComponent (Maybe (NP I fs -> Either ParseError a))+newtype ParserComponent a fs = ParserComponent (Maybe (Value -> NP I fs -> Either ParseError a)) -- | A top-level YAML parser. -- -- * Construct a 'Parser' with 'string', 'number', 'integer', 'bool', 'array', or 'object'.@@ -136,7 +138,7 @@  -- fmap for ParserComponent (in its first type argument) pcFmap :: (a -> b) -> ParserComponent a fs -> ParserComponent b fs-pcFmap f (ParserComponent mbP) = ParserComponent $ (fmap . fmap . fmap $ f) mbP+pcFmap f (ParserComponent mbP) = ParserComponent $ (fmap . fmap . fmap . fmap $ f) mbP  instance Functor Parser where   fmap f (Parser comps) = Parser $ hliftA (pcFmap f) comps@@ -148,8 +150,8 @@       (Nothing, Nothing) -> Nothing       (Just p1, Nothing) -> Just p1       (Nothing, Just p2) -> Just p2-      (Just p1, Just p2) -> Just $ \v ->-        case (p1 v, p2 v) of+      (Just p1, Just p2) -> Just $ \o v ->+        case (p1 o v, p2 o v) of           (Right r1, _) -> Right r1           (_, Right r2) -> Right r2           (Left l1, Left l2) -> Left $ mergeParseError l1 l2@@ -167,7 +169,7 @@     match (ParserComponent mbP) v1 = K $       case mbP of         Nothing -> Left $ ParseError 0 $ ExpectedInsteadOf expected orig-        Just p -> p v1+        Just p -> p orig v1      expected =       let@@ -182,11 +184,21 @@   fromComponent :: forall a . NS (ParserComponent a) (Code Value) -> Parser a-fromComponent parser = Parser $ hap' (hliftA (Fn . const) parser) (hpure mempty :: NP (ParserComponent a) (Code Value))+fromComponent parser = Parser $ hexpand mempty parser -hap' :: forall f (xs :: [k]) . NS (f -.-> f) xs -> NP f xs -> NP f xs-hap' (Z (Fn f)) (h :* t) = f h :* t-hap' (S f) (h :* t) = h :* hap' f t+-- Wrap a parser with a decorator. The decorator has access to the parsed value as well+-- as the original and can inject its own processing logic.+decorate :: forall a b. Parser a -> (a -> Value -> Either ParseError b) -> Parser b+decorate (Parser components) decorator = Parser $ hmap wrap components+  where+    wrap :: ParserComponent a fs -> ParserComponent b fs+    wrap (ParserComponent maybeP) = ParserComponent $+      case maybeP of+        Nothing -> Nothing+        Just p -> Just $ \orig val ->+          case p orig val of+            Left err     -> Left err+            Right parsed -> decorator parsed orig  ---------------------------------------------------------------------- --                           Combinators@@ -200,7 +212,7 @@ -- >>> parse string "howdy" -- Right "howdy" string :: Parser Text-string = fromComponent $ S . S . Z $ ParserComponent $ Just $ \(I s :* Nil) -> Right s+string = fromComponent $ S . S . Z $ ParserComponent $ Just $ const $ \(I s :* Nil) -> Right s  -- | Match a specific YAML string, usually a «tag» identifying a particular -- form of an array or object.@@ -212,7 +224,7 @@ -- <BLANKLINE> -- bye theString :: Text -> Parser ()-theString t = fromComponent $ S . S . Z $ ParserComponent $ Just $ \(I s :* Nil) ->+theString t = fromComponent $ S . S . Z $ ParserComponent $ Just $ const $ \(I s :* Nil) ->   if s == t     then Right ()     else Left $ ParseError 1 (ExpectedInsteadOf (show t) (String s))@@ -224,7 +236,7 @@ -- >>> parse (array string) "[a,b,c]" -- Right ["a","b","c"] array :: Parser a -> Parser (Vector a)-array p = fromComponent $ S . Z $ ParserComponent $ Just $ \(I a :* Nil) -> incErrLevel $ mapM (runParser p) a+array p = fromComponent $ S . Z $ ParserComponent $ Just $ const $ \(I a :* Nil) -> incErrLevel $ mapM (runParser p) a  -- | An 'ElementParser' describes how to parse a fixed-size array -- where each positional element has its own parser.@@ -258,7 +270,7 @@ -- >>> parse (theArray $ (,) <$> element string <*> element bool) "[f, true]" -- Right ("f",True) theArray :: ElementParser a -> Parser a-theArray (ElementParser ep) = fromComponent $ S . Z $ ParserComponent $ Just $ \(I a :* Nil) -> incErrLevel $+theArray (ElementParser ep) = fromComponent $ S . Z $ ParserComponent $ Just $ const $ \(I a :* Nil) -> incErrLevel $   case runStateT ep (V.toList a) of     Right (r, []) -> return r     Right (_, v:_) -> Left $ ParseError 0 $ UnexpectedAsPartOf v $ Array a@@ -269,14 +281,14 @@ -- >>> parse number "3.14159" -- Right 3.14159 number :: Parser Scientific-number = fromComponent $ S . S . S . Z $ ParserComponent $ Just $ \(I n :* Nil) -> Right n+number = fromComponent $ S . S . S . Z $ ParserComponent $ Just $ const $ \(I n :* Nil) -> Right n  -- | Match an integer. -- -- >>> parse (integer @Int) "2017" -- Right 2017 integer :: (Integral i, Bounded i) => Parser i-integer = fromComponent $ S . S . S . Z $ ParserComponent $ Just $ \(I n :* Nil) ->+integer = fromComponent $ S . S . S . Z $ ParserComponent $ Just $ const $ \(I n :* Nil) ->   case toBoundedInteger n of     Just i -> Right i     Nothing -> Left $ ParseError 0 $ ExpectedInsteadOf "integer" (Number n)@@ -286,8 +298,31 @@ -- >>> parse bool "yes" -- Right True bool :: Parser Bool-bool = fromComponent $ S . S . S . S . Z $ ParserComponent $ Just $ \(I b :* Nil) -> Right b+bool = fromComponent $ S . S . S . S . Z $ ParserComponent $ Just $ const $ \(I b :* Nil) -> Right b +-- | Make a parser match only valid values.+--+-- If the validator does not accept the value, it should return a+-- 'Left' 'String' with a noun phrase that characterizes the expected+-- value, as in the example:+--+-- >>> let acceptEven n = if even n then Right n else Left "an even number"+-- >>> either putStr print $ parse (integer @Int `validate` acceptEven) "2017"+-- Expected an even number instead of:+-- <BLANKLINE>+-- 2017+--+-- @since 1.0.1+validate ::+  Parser a -- ^ parser to wrap+  -> (a -> Either String b) -- ^ validator+  -> Parser b+validate parser validator =+  decorate parser (validity . validator)+  where+    validity (Right result) _    = Right result+    validity (Left problem) orig = Left $ ParseError 1 $ ExpectedInsteadOf problem orig+ -- | A 'FieldParser' describes how to parse an object. -- -- * Construct a 'FieldParser' with 'field', 'optField', or 'theField', and the 'Applicative' combinators.@@ -325,6 +360,15 @@     (ReaderT $ \o -> traverse (incErrLevel . runParser p) $ HM.lookup name o)     (Constant $ HM.singleton name ()) +-- | Declare an optional object field with the given name and with a default+-- to use if the field is absent.+defaultField+  :: Text -- ^ field name+  -> a -- ^ default value+  -> Parser a -- ^ value parser+  -> FieldParser a+defaultField name defaultVal p = fromMaybe defaultVal <$> optField name p+ -- | Require an object field with the given name and the given string value. -- -- This is a convenient wrapper around 'theString' intended for «tagging»@@ -354,7 +398,7 @@ -- >>> parse p "name: Roma" -- Right ("Roma",Nothing) object :: FieldParser a -> Parser a-object (FieldParser (Pair (ReaderT parseFn) (Constant names))) = fromComponent $ Z $ ParserComponent $ Just $ \(I o :* Nil) ->+object (FieldParser (Pair (ReaderT parseFn) (Constant names))) = fromComponent $ Z $ ParserComponent $ Just $ const $ \(I o :* Nil) ->   incErrLevel $     parseFn o <*     (case HM.keys (HM.difference o names) of
tests/test.hs view
@@ -34,6 +34,12 @@   , testCase "Expect an object, get an object" $       runParser (object $ field "foo" number) (Object [("foo", Number 1)]) @?=         Right 1+  , testCase "Validated String, accepts anything" $+      runParser (validate string Right) (String "foo") @?=+        Right "foo"+  , testCase "Validated String, rejects everything" $+      runParser (validate string (const (Left "contrarianism" :: Either String String))) (String "foo") @?=+        Left (ParseError 1 (ExpectedInsteadOf "contrarianism" (String "foo")))   , testCase "Expect an object, get an array" $       runParser (object $ field "foo" number) (Array []) @?=         Left (ParseError 0 $ ExpectedInsteadOf "Object" (Array []))@@ -52,6 +58,12 @@   , testCase "Expect an object with opt field, field absent" $       runParser (object $ optField "foo" number) (Object []) @?=         Right Nothing+  , testCase "Expect an object with default field, field present" $+      runParser (object $ defaultField "foo" 7 number) (Object [("foo", Number 16309)]) @?=+        Right 16309+  , testCase "Expect an object with default field, field present" $+      runParser (object $ defaultField "foo" 7 number) (Object []) @?=+        Right 7   , testCase "Expect an array of number and string, get it" $       runParser         (theArray $ (,) <$> element number <*> element string)
yaml-combinators.cabal view
@@ -2,9 +2,10 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                yaml-combinators-version:             1.0+version:             1.0.1 synopsis:            YAML parsing combinators for improved validation and error reporting--- description:+description:         Based on the article+                     <https://ro-che.info/articles/2015-07-26-better-yaml-parsing Better Yaml Parsing>. homepage:            https://github.com/feuerbach/yaml-combinators license:             MIT license-file:        LICENSE@@ -14,19 +15,25 @@                      (c) 2017 Roman Cheplyaka category:            Text build-type:          Simple-extra-source-files:  ChangeLog.md+extra-source-files:  ChangeLog.md, README.md cabal-version:       >=1.10 +source-repository head+  type:     git+  location: git://github.com/feuerbach/yaml-combinators.git+ library+  default-language:+    Haskell2010   exposed-modules:     Data.Yaml.Combinators   -- other-modules:   -- other-extensions:   build-depends:     aeson,-    base < 5,+    base >= 4.8 && < 5,     bytestring,-    generics-sop,+    generics-sop >= 0.2.5,     scientific,     text,     transformers,@@ -35,7 +42,7 @@     yaml   hs-source-dirs:      src   default-language:    Haskell2010-  ghc-options: -Wall -Wno-orphans+  ghc-options: -Wall -fno-warn-orphans  test-suite test   default-language:@@ -62,3 +69,5 @@   main-is:     doctests.hs   build-depends: base, doctest+  default-language:+    Haskell2010