HsYAML 0.1.0.0 → 0.1.1.0

raw patch · 5 files changed

+162/−80 lines, 5 filesdep +faildep +natsPVP ok

version bump matches the API change (PVP)

Dependencies added: fail, nats

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• HsYAML.cabal +20/−9
• src-test/Main.hs +34/−9
• src/Data/YAML.hs +96/−62
• src/Util.hs +1/−0

@@ -0,0 +1,11 @@+### 0.1.1.0++* `Data.YAML` module promoted from `TrustWorthy` to `Safe`+* Add `FromYAML Natural` instance+* Add `Alternative` and `MonadPlus` instances for `Data.YAML.Parser`+* Add `Data.YAML.decodeStrict` function+* Export `Data.YAML.typeMismatch` helper function++## 0.1.0.0++* First version. Released on an unsuspecting world.

@@ -1,9 +1,10 @@ cabal-version:       1.14 name:                HsYAML-version:             0.1.0.0+version:             0.1.1.0  synopsis:            Pure Haskell YAML 1.2 parser homepage:            https://github.com/hvr/HsYAML+bug-reports:         https://github.com/hvr/HsYAML/issues license:             GPL-3 license-file:        LICENSE author:              Herbert Valerio Riedel@@ -15,17 +16,21 @@ tested-with:         GHC==8.4.3, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2  description:-  @HsYAML@ is a [YAML 1.2](http://yaml.org/spec/1.2/spec.html) parser for Haskell.+  @HsYAML@ is a [YAML 1.2](http://yaml.org/spec/1.2/spec.html) parser implementation for Haskell.   .-  Features include:+  Features of @HsYAML@ include:   .-   * Pure Haskell implementation with small dependency footprint and emphasis on strict compliance with the [YAML 1.2 specification](http://yaml.org/spec/1.2/spec.html)-   * Low-level API access to lexical token-based scanner ("Data.YAML.Token")-   * Event-based API resembling LibYAML's Event-based API ("Data.YAML.Event")-   * Support for constructing custom YAML node graph representation (including support for cyclic YAML data structures)-   * Direct decoding via typeclass-based API similiar to @aeson@ ("Data.YAML")-   * Support for /Failsafe/, /JSON/ and /Core/ schemas as defined in the YAML 1.2 specification (including support for user-defined custom schemas)+   * Pure Haskell implementation with small dependency footprint and emphasis on strict compliance with the [YAML 1.2 specification](http://yaml.org/spec/1.2/spec.html).+   * Direct decoding to native Haskell types via (@aeson@-inspired) typeclass-based API (see "Data.YAML").+   * Support for constructing custom YAML node graph representation (including support for cyclic YAML data structures).+   * Support for the standard (untyped) /Failsafe/, (strict) /JSON/, and (flexible) /Core/ \"schemas\" providing implicit typing rules as defined in the YAML 1.2 specification (including support for user-defined custom schemas).+   * Event-based API resembling LibYAML's Event-based API (see "Data.YAML.Event").+   * Low-level API access to lexical token-based scanner (see "Data.YAML.Token").+   . +extra-source-files:+  ChangeLog.md+ source-repository head   type: git   location: https://github.com/hvr/HsYAML.git@@ -65,6 +70,12 @@                      , text         >=1.2.3 && <1.3                      , mtl          >=2.2.1 && <2.3                      , parsec       >=3.1.13.0 && < 3.2++  if !impl(ghc >= 8.0)+    build-depends:     fail         >=4.9.0.0 && <4.10++  if !impl(ghc >= 7.10)+    build-depends:     nats         >=1.1.2 && <1.2    ghc-options:         -Wall 

@@ -159,6 +159,23 @@ unescapeSpcTab :: T.Text -> T.Text unescapeSpcTab = T.replace "<SPC>" " " . T.replace "<TAB>" "\t" ++data TestPass = PassExpErr   -- ^ expected parse fail+              | PassEvs      -- ^ events ok+              | PassEvsJson  -- ^ events+json ok+              deriving (Eq,Ord,Show)++data TestFail = FailParse    -- ^ unexpected parse fail+              | FailSuccess  -- ^ unexpected parse success+              | FailEvs      -- ^ events wrong/mismatched+              | FailJson     -- ^ JSON wrong/mismatched+              deriving (Eq,Ord,Show)++data TestRes+  = Pass !TestPass+  | Fail !TestFail+  deriving (Eq,Ord,Show)+ cmdRunTml :: [FilePath] -> IO () cmdRunTml args = do   results <- forM args $ \fn -> do@@ -185,7 +202,7 @@         Left err           | isErr -> do               putStrLn "OK! (error)"-              pure True+              pure (Pass PassExpErr)           | otherwise -> do               putStrLn "FAIL!"               putStrLn ""@@ -204,7 +221,7 @@               putStrLn ""               putStrLn "----------------------------------------------------------------------------"               putStrLn ""-              pure False+              pure (Fail FailParse)          Right evs' -> do           let evs'' = map ev2str evs'@@ -214,21 +231,21 @@                case mInJsonDat of                  Nothing -> do                    putStrLn "OK!"-                   pure True+                   pure (Pass PassEvs)                  Just inJsonDat -> do                    iutJson <- either fail pure $ decodeAeson inYamlDat                     if iutJson == inJsonDat                      then do                        putStrLn "OK! (+JSON)"-                       pure True+                       pure (Pass PassEvsJson)                      else do                        putStrLn "FAIL! (bad JSON)"                         putStrLn' ("ref = " ++ show inJsonDat)                        putStrLn' ("iut = " ++ show iutJson) -                       pure False+                       pure (Fail FailJson)               else do                if isErr@@ -250,15 +267,23 @@                putStrLn ""                putStrLn "----------------------------------------------------------------------------"                putStrLn ""-               pure False+               pure (Fail (if isErr then FailSuccess else FailEvs))    putStrLn "" -  let ok = length (filter id results')-      nok = length (filter not results')+  let ok = length [ () | Pass _ <- results' ]+      nok = length [ () | Fail _ <- results' ]++      stat j = show $ Map.findWithDefault 0 j $ Map.fromListWith (+) [ (k,1::Int) | k <- results' ]+       results' = concat results -  putStrLn ("done (passed: " ++ show ok ++ " / failed: " ++ show nok ++ ")")+  putStrLn $ concat+    [ "done -- passed: ", show ok+    , " (ev: ", stat (Pass PassEvs), ", ev+json: ", stat (Pass PassEvsJson), ", err: ", stat (Pass PassExpErr), ") / "+    , "failed: ", show nok+    , " (err: ", stat (Fail FailParse), ", ev:", stat (Fail FailEvs), ", json:", stat (Fail FailJson), ", ok:", stat (Fail FailSuccess), ")"+    ]   -- | Incomplete proof-of-concept 'testml-compiler' operation

@@ -1,25 +1,30 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE Trustworthy                #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE Safe              #-}  -- | -- Copyright: © Herbert Valerio Riedel 2015-2018 -- SPDX-License-Identifier: GPL-3.0 ----- Document oriented YAML parsing API inspired by [aeson](http://hackage.haskell.org/package/aeson).+-- Document oriented [YAML](http://yaml.org/spec/1.2/spec.html) parsing API inspired by [aeson](http://hackage.haskell.org/package/aeson). ----- === Usage Example+-- === Overview ----- Let's assume we want to decode a simple YAML document+-- The diagram below depicts the standard layers of a [YAML 1.2](http://yaml.org/spec/1.2/spec.html) processor. This module covers the upper /Native/ and /Representation/ layers, whereas the "Data.YAML.Event" and "Data.YAML.Token" modules provide access to the lower /Serialization/ and /Presentation/ layers respectively. --+-- <<http://yaml.org/spec/1.2/overview2.png>>+--+-- === Quick Start Tutorial+--+-- Let's assume we want to decode (i.e. /load/) a simple YAML document+-- -- > - name: Erik Weisz -- >   age: 52 -- >   magic: True -- > - name: Mina Crandon -- >   age: 53 ----- into a Haskell list of person records, i.e. a value of type @[Person]@.+-- into a native Haskell data structure of type @[Person]@, i.e. a list of 'Person' records. -- -- The code below shows how to manually define a @Person@ record type together with a 'FromYAML' instance: --@@ -49,9 +54,11 @@     (       -- * Typeclass-based resolving/decoding       decode+    , decodeStrict     , FromYAML(..)     , Parser     , parseEither+    , typeMismatch        -- ** Accessors for YAML 'Mapping's     , Mapping@@ -86,6 +93,8 @@      ) where +import qualified Control.Monad.Fail   as Fail+import qualified Data.ByteString      as BS import qualified Data.ByteString.Lazy as BS.L import qualified Data.Map             as Map import qualified Data.Text            as T@@ -182,24 +191,63 @@ -- -- See also 'parseEither' or 'decode' newtype Parser a = P { unP :: Either String a }-                 deriving (Functor,Applicative) --- TODO: MonadFail+instance Functor Parser where+  fmap f (P x) = P (fmap f x)++  x <$ P (Right _) = P (Right x)+  _ <$ P (Left e)  = P (Left e)++instance Applicative Parser where+  pure = P . Right++  P (Left e)  <*> _   = P (Left e)+  P (Right f) <*> P r = P (fmap f r)++  P (Left e)   *> _   = P (Left e)+  P (Right _)  *> p   = p+ instance Monad Parser where   return = pure   P m >>= k = P (m >>= unP . k)   (>>) = (*>)+  fail = Fail.fail++-- | @since 0.1.1.0+instance Fail.MonadFail Parser where   fail = P . Left +-- | @since 0.1.1.0+instance Alternative Parser where+  empty = fail "empty"++  P (Left _) <|> y = y+  x          <|> _ = x++-- | @since 0.1.1.0+instance MonadPlus Parser where+  mzero = empty+  mplus = (<|>)+ -- | Run 'Parser' -- -- A common use-case is 'parseEither' 'parseYAML'. parseEither :: Parser a -> Either String a parseEither = unP --- helper-failTypeMismatch :: String -> Node -> Parser a-failTypeMismatch expected node = fail ("expected " ++ expected ++ " instead of " ++ got)+-- | Informative failure helper+--+-- This is typically used in fall-through cases of 'parseYAML' like so+--+-- > instance FromYAML ... where+-- >   parseYAML ...  = ...+-- >   parseYAML node = typeMismatch "SomeThing" node+--+-- @since 0.1.1.0+typeMismatch :: String   -- ^ descriptive name of expected data+             -> Node     -- ^ actual node+             -> Parser a+typeMismatch expected node = fail ("expected " ++ expected ++ " instead of " ++ got)   where     got = case node of             Scalar (SBool _)             -> "!!bool"@@ -225,7 +273,7 @@ -- | Operate on @tag:yaml.org,2002:null@ node (or fail) withNull :: String -> Parser a -> Node -> Parser a withNull _        f (Scalar SNull) = f-withNull expected _ v              = failTypeMismatch expected v+withNull expected _ v              = typeMismatch expected v   -- | Trivial instance@@ -238,7 +286,7 @@ -- | Operate on @tag:yaml.org,2002:bool@ node (or fail) withBool :: String -> (Bool -> Parser a) -> Node -> Parser a withBool _        f (Scalar (SBool b)) = f b-withBool expected _ v                  = failTypeMismatch expected v+withBool expected _ v                  = typeMismatch expected v  instance FromYAML Text where   parseYAML = withStr "!!str" pure@@ -246,7 +294,7 @@ -- | Operate on @tag:yaml.org,2002:str@ node (or fail) withStr :: String -> (Text -> Parser a) -> Node -> Parser a withStr _        f (Scalar (SStr b)) = f b-withStr expected _ v                 = failTypeMismatch expected v+withStr expected _ v                 = typeMismatch expected v  instance FromYAML Integer where   parseYAML = withInt "!!int" pure@@ -254,59 +302,40 @@ -- | Operate on @tag:yaml.org,2002:int@ node (or fail) withInt :: String -> (Integer -> Parser a) -> Node -> Parser a withInt _        f (Scalar (SInt b)) = f b-withInt expected _ v                 = failTypeMismatch expected v+withInt expected _ v                 = typeMismatch expected v +-- | @since 0.1.0.0+instance FromYAML Natural where+  parseYAML = withInt "!!int" $ \b -> if b < 0 then fail ("!!int " ++ show b ++ " out of range for 'Natural'")+                                               else pure (fromInteger b)++-- helper for fixed-width integers+{-# INLINE parseInt #-}+parseInt :: (Integral a, Bounded a) => [Char] -> Node -> Parser a+parseInt name = withInt "!!int" $ \b -> maybe (fail $ "!!int " ++ show b ++ " out of range for '" ++ name ++ "'") pure $+                                        fromIntegerMaybe b++instance FromYAML Int    where parseYAML = parseInt "Int"+instance FromYAML Int8   where parseYAML = parseInt "Int8"+instance FromYAML Int16  where parseYAML = parseInt "Int16"+instance FromYAML Int32  where parseYAML = parseInt "Int32"+instance FromYAML Int64  where parseYAML = parseInt "Int64"+instance FromYAML Word   where parseYAML = parseInt "Word"+instance FromYAML Word8  where parseYAML = parseInt "Word8"+instance FromYAML Word16 where parseYAML = parseInt "Word16"+instance FromYAML Word32 where parseYAML = parseInt "Word32"+instance FromYAML Word64 where parseYAML = parseInt "Word64"++ instance FromYAML Double where   parseYAML = withFloat "!!float" pure  -- | Operate on @tag:yaml.org,2002:float@ node (or fail) withFloat :: String -> (Double -> Parser a) -> Node -> Parser a withFloat _        f (Scalar (SFloat b)) = f b-withFloat expected _ v                   = failTypeMismatch expected v---- signed fixed-width integers--instance FromYAML Int where-  parseYAML (Scalar (SInt b)) = maybe (fail $ "!!int " ++ show b ++ " out of range for 'Int'") pure $ fromIntegerMaybe b-  parseYAML n                    = failTypeMismatch "!!int" n--instance FromYAML Int8 where-  parseYAML (Scalar (SInt b)) = maybe (fail $ "!!int " ++ show b ++ " out of range for 'Int8'") pure $ fromIntegerMaybe b-  parseYAML n                    = failTypeMismatch "!!int" n--instance FromYAML Int16 where-  parseYAML (Scalar (SInt b)) = maybe (fail $ "!!int " ++ show b ++ " out of range for 'Int16'") pure $ fromIntegerMaybe b-  parseYAML n                    = failTypeMismatch "!!int" n--instance FromYAML Int32 where-  parseYAML (Scalar (SInt b)) = maybe (fail $ "!!int " ++ show b ++ " out of range for 'Int32'") pure $ fromIntegerMaybe b-  parseYAML n                    = failTypeMismatch "!!int" n--instance FromYAML Int64 where-  parseYAML (Scalar (SInt b)) = maybe (fail $ "!!int " ++ show b ++ " out of range for 'Int64'") pure $ fromIntegerMaybe b-  parseYAML n                    = failTypeMismatch "!!int" n+withFloat expected _ v                   = typeMismatch expected v  -instance FromYAML Word where-  parseYAML (Scalar (SInt b)) = maybe (fail $ "!!int " ++ show b ++ " out of range for 'Word'") pure $ fromIntegerMaybe b-  parseYAML n                    = failTypeMismatch "!!int" n--instance FromYAML Word8 where-  parseYAML (Scalar (SInt b)) = maybe (fail $ "!!int " ++ show b ++ " out of range for 'Word8'") pure $ fromIntegerMaybe b-  parseYAML n                    = failTypeMismatch "!!int" n--instance FromYAML Word16 where-  parseYAML (Scalar (SInt b)) = maybe (fail $ "!!int " ++ show b ++ " out of range for 'Word16'") pure $ fromIntegerMaybe b-  parseYAML n                    = failTypeMismatch "!!int" n--instance FromYAML Word32 where-  parseYAML (Scalar (SInt b)) = maybe (fail $ "!!int " ++ show b ++ " out of range for 'Word32'") pure $ fromIntegerMaybe b-  parseYAML n                    = failTypeMismatch "!!int" n--instance FromYAML Word64 where-  parseYAML (Scalar (SInt b)) = maybe (fail $ "!!int " ++ show b ++ " out of range for 'Word64'") pure $ fromIntegerMaybe b-  parseYAML n                    = failTypeMismatch "!!int" n- instance (Ord k, FromYAML k, FromYAML v) => FromYAML (Map k v) where   parseYAML = withMap "!!map" $ \xs -> Map.fromList <$> mapM (\(a,b) -> (,) <$> parseYAML a <*> parseYAML b) (Map.toList xs) @@ -314,7 +343,7 @@ withMap :: String -> (Mapping -> Parser a) -> Node -> Parser a withMap _        f (Mapping tag xs)   | tag == tagMap    = f xs-withMap expected _ v = failTypeMismatch expected v+withMap expected _ v = typeMismatch expected v  instance FromYAML v => FromYAML [v] where   parseYAML = withSeq "!!seq" (mapM parseYAML)@@ -323,7 +352,7 @@ withSeq :: String -> ([Node] -> Parser a) -> Node -> Parser a withSeq _        f (Sequence tag xs)   | tag == tagSeq    = f xs-withSeq expected _ v = failTypeMismatch expected v+withSeq expected _ v = typeMismatch expected v  instance FromYAML a => FromYAML (Maybe a) where   parseYAML (Scalar SNull) = pure Nothing@@ -414,3 +443,8 @@ decode :: FromYAML v => BS.L.ByteString -> Either String [v] decode bs0 = decodeNode bs0 >>= mapM (parseEither . parseYAML . (\(Doc x) -> x)) +-- | Like 'decode' but takes a strict 'BS.ByteString'+--+-- @since 0.1.1.0+decodeStrict :: FromYAML v => BS.ByteString -> Either String [v]+decodeStrict = decode . BS.L.fromChunks . (:[])

@@ -21,6 +21,7 @@ import           Control.Monad                as X import           Data.Int                     as X import           Data.Word                    as X+import           Numeric.Natural              as X (Natural)  import           Control.Monad.Except import           Control.Monad.Identity       as X