yaml 0.8.9.4 → 0.8.10
raw patch · 14 files changed
+598/−457 lines, 14 filesdep +aeson-qqdep +filepathdep ~conduit
Dependencies added: aeson-qq, filepath
Dependency ranges changed: conduit
Files
- ChangeLog.md +3/−0
- Data/Yaml.hs +1/−0
- Data/Yaml/Include.hs +62/−0
- README.md +19/−0
- test/Data/Yaml/IncludeSpec.hs +37/−0
- test/Data/YamlSpec.hs +443/−0
- test/Spec.hs +1/−0
- test/main.hs +0/−438
- test/resources/bar.yaml +2/−0
- test/resources/baz.yaml +1/−0
- test/resources/foo.yaml +3/−0
- test/resources/loop/bar.yaml +2/−0
- test/resources/loop/foo.yaml +3/−0
- yaml.cabal +21/−19
+ ChangeLog.md view
@@ -0,0 +1,3 @@+## 0.8.10++Add the Data.Yaml.Include module
Data/Yaml.hs view
@@ -183,6 +183,7 @@ | AesonException String | OtherParseException SomeException | NonStringKeyAlias Y.AnchorName Value+ | CyclicIncludes deriving (Show, Typeable) instance Exception ParseException
+ Data/Yaml/Include.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE RankNTypes #-}+module Data.Yaml.Include (decodeFile, decodeFileEither) where++import Control.Applicative+import Control.Monad (when)+import Control.Exception (throwIO)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Resource (MonadResource)+import System.Directory+import System.FilePath+import Data.Text (unpack)+import Data.Text.Encoding (decodeUtf8)+import Data.Aeson (FromJSON)+import Data.Conduit+import qualified Data.Conduit.List as CL+import Data.Yaml (ParseException(..), decodeHelper)+import Text.Libyaml hiding (decodeFile)+import qualified Text.Libyaml as Y++eventsFromFile+ :: MonadResource m+ => FilePath+ -> Producer m Event+eventsFromFile = go []+ where+ go :: MonadResource m => [FilePath] -> FilePath -> Producer m Event+ go seen fp = do+ cfp <- liftIO $ canonicalizePath fp+ when (cfp `elem` seen) $ do+ liftIO $ throwIO CyclicIncludes+ Y.decodeFile cfp $= do+ awaitForever $ \event -> case event of+ EventScalar f (UriTag "!include") _ _ -> do+ let includeFile = takeDirectory cfp </> unpack (decodeUtf8 f)+ go (cfp : seen) includeFile $= CL.filter (`notElem` irrelevantEvents)+ _ -> yield event++ irrelevantEvents = [EventStreamStart, EventDocumentStart, EventDocumentEnd, EventStreamEnd]++-- | Like `Data.Yaml.decodeFile` but with support for relative and absolute+-- includes.+--+-- The syntax for includes follows the form:+--+-- > somekey: !include ./somefile.yaml+decodeFile+ :: FromJSON a+ => FilePath+ -> IO (Maybe a)+decodeFile fp = decodeHelper (eventsFromFile fp) >>= either throwIO (return . either (const Nothing) id)++-- | Like `Data.Yaml.decodeFileEither` but with support for relative and+-- absolute includes.+--+-- The syntax for includes follows the form:+--+-- > somekey: !include ./somefile.yaml+decodeFileEither+ :: FromJSON a+ => FilePath+ -> IO (Either ParseException a)+decodeFileEither fp = either Left (either (Left . AesonException) Right) <$> decodeHelper (eventsFromFile fp)
+ README.md view
@@ -0,0 +1,19 @@+## yaml++Provides support for parsing and emitting Yaml documents.++This package includes the [full libyaml C library version 0.1.5 by Kirill+Simonov](http://pyyaml.org/wiki/LibYAML) in the package so you+don't need to worry about any non-Haskell dependencies.++The package is broken down into two primary modules.+"Data.Yaml" provides a high-level interface based+around the JSON datatypes provided by the @aeson@+package. "Text.Libyaml" provides a lower-level,+streaming interface. For most users, "Data.Yaml" is recommended.++Additional modules:++* Data.Yaml.Include supports adding `!include` directives to your YAML files.+* DAta.Yaml.Builder and Data.Yaml.Parser allow more fine-grained control of parsing an rendering, as opposed to just using the aeson typeclass and datatype system for parsing and rendering.+* Data.Yaml.Aeson is currently a re-export of Data.Yaml to explicitly choose to use the aeson-compatible API.
+ test/Data/Yaml/IncludeSpec.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE QuasiQuotes #-}+module Data.Yaml.IncludeSpec (main, spec) where++import Test.Hspec+import Data.Aeson+import Data.Aeson.QQ++import Data.Yaml.Include++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "decodeFile" $ do+ it "supports includes" $ do+ decodeFile "test/resources/foo.yaml" `shouldReturn` Just [aesonQQ|+ {+ foo: 23,+ bar: {one: 1, two: 2},+ baz: 42+ }+ |]++ it "supports recursive includes" $ do+ decodeFile "test/resources/baz.yaml" `shouldReturn` Just [aesonQQ|+ {+ foo: {+ foo: 23,+ bar: {one: 1, two: 2},+ baz: 42+ }+ }+ |]++ it "aborts on cyclic includes" $ do+ (decodeFile "test/resources/loop/foo.yaml" :: IO (Maybe Value)) `shouldThrow` anyException
+ test/Data/YamlSpec.hs view
@@ -0,0 +1,443 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.YamlSpec (main, spec) where++import qualified Text.Libyaml as Y+import qualified Data.ByteString.Char8 as B8++import Test.HUnit hiding (Test, path)++import qualified Data.Conduit as C+import qualified Control.Monad.Trans.Resource as C+import qualified Data.Conduit.List as CL++import System.Directory+import Control.Monad+import Control.Exception (try, SomeException)+import Test.Hspec++import qualified Data.Yaml as D+import Data.Yaml (object, array, (.=))+import Data.Maybe+import qualified Data.HashMap.Strict as M+import qualified Data.Text as T+import Data.Aeson.TH+import Data.Text (Text)+import Data.Vector (Vector)+import qualified Data.Vector as V+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM++data TestJSON = TestJSON+ { string :: Text+ , number :: Int+ , anArray :: Vector Text+ , hash :: HashMap Text Text+ , extrastring :: Text+ } deriving (Show, Eq)++deriveJSON defaultOptions ''TestJSON++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "streaming" $ do+ it "count scalars with anchor" caseCountScalarsWithAnchor+ it "count sequences with anchor" caseCountSequencesWithAnchor+ it "count mappings with anchor" caseCountMappingsWithAnchor+ it "count aliases" caseCountAliases+ it "count scalars" caseCountScalars+ it "largest string" caseLargestString+ it "encode/decode" caseEncodeDecode+ it "encode/decode file" caseEncodeDecodeFile+ it "interleaved encode/decode" caseInterleave+ it "decode invalid document (without segfault)" caseDecodeInvalidDocument+ describe "Data.Yaml" $ do+ it "encode/decode" caseEncodeDecodeData+ it "encode/decode file" caseEncodeDecodeFileData+ it "encode/decode strings" caseEncodeDecodeStrings+ it "decode invalid file" caseDecodeInvalid+ it "processes datatypes" caseDataTypes+ describe "Data.Yaml aliases" $ do+ it "simple scalar alias" caseSimpleScalarAlias+ it "simple sequence alias" caseSimpleSequenceAlias+ it "simple mapping alias" caseSimpleMappingAlias+ it "mapping alias before anchor" caseMappingAliasBeforeAnchor+ it "mapping alias inside anchor" caseMappingAliasInsideAnchor+ it "scalar alias overriding" caseScalarAliasOverriding+ describe "Data.Yaml merge keys" $ do+ it "test uniqueness of keys" caseAllKeysShouldBeUnique+ it "test mapping merge" caseSimpleMappingMerge+ it "test sequence of mappings merging" caseMergeSequence+ describe "numbers" $ do+ it "parses as string when quoted" caseQuotedNumber+ it "parses as number when unquoted" caseUnquotedNumber+ it "parses as number !!str is present" caseAttribNumber+ it "integers have no decimals" caseIntegerDecimals+ describe "booleans" $ do+ it "parses when all lowercase" caseLowercaseBool+ it "parses when all uppercase" caseUppercaseBool+ it "parses when titlecase" caseTitlecaseBool+ describe "empty input" $ do+ it "doesn't crash" caseEmptyInput+ describe "alias stripping" $ do+ it "works" caseStripAlias+ describe "nulls" $ do+ checkNull "null"+ checkNull "Null"+ checkNull "NULL"+ checkNull "~"+ checkNull ""++ describe "pretty output" $ do+ it "simple nulls" $ D.encode (object ["foo" .= D.Null]) `shouldBe` "foo: null\n"+ it "simple numbers" $ D.encode (object ["foo" .= (4 :: Int)]) `shouldBe` "foo: 4\n"+ it "True" $ D.encode (object ["foo" .= True]) `shouldBe` "foo: true\n"+ it "False" $ D.encode (object ["foo" .= False]) `shouldBe` "foo: false\n"+ it "simple string" $ D.encode (object ["foo" .= ("bar" :: T.Text)]) `shouldBe` "foo: bar\n"++ describe "special keys" $ do+ let tester key = it (T.unpack key) $+ let value = object [key .= True]+ in D.decode (D.encode value) `shouldBe` Just value+ mapM_ tester specialStrings++ describe "special values" $ do+ let tester value = it (T.unpack value) $+ let value' = object ["foo" .= value]+ in D.decode (D.encode value') `shouldBe` Just value'+ mapM_ tester specialStrings++ describe "yamlFileJSONparse" $+ it "loads YAML through JSON into Haskell data" $ do+ tj <- either (error . show) id `fmap` D.decodeFileEither "test/json.yaml"+ tj `shouldBe` TestJSON+ { string = "str"+ , number = 2+ , anArray = V.fromList ["a", "b"]+ , hash = HM.fromList [("key1", "value1"), ("key2", "value2")]+ , extrastring = "1234-foo"+ }++ describe "round-tripping of special scalars" $ do+ let special = words "y Y On ON false 12345 12345.0 12345a 12e3"+ forM_ special $ \w -> it w $+ let v = object ["word" .= w]+ in D.decode (D.encode v) `shouldBe` Just v+ it "no tags" $ D.encode (object ["word" .= ("true" :: String)]) `shouldBe` "word: 'true'\n"++ it "aliases in keys #49" caseIssue49+++specialStrings :: [T.Text]+specialStrings =+ [ "fo\"o"+ , "fo\'o"+ , "fo\\'o"+ , "fo: o"+ , "foo\nbar\nbaz\n"+ ]++counter :: Monad m => (Y.Event -> Bool) -> C.Sink Y.Event m Int+counter pred' =+ CL.fold (\cnt e -> (if pred' e then 1 else 0) + cnt) 0++caseHelper :: String+ -> (Y.Event -> Bool)+ -> Int+ -> Assertion+caseHelper yamlString pred' expRes = do+ res <- C.runResourceT $ Y.decode (B8.pack yamlString) C.$$ counter pred'+ res @?= expRes++caseCountScalarsWithAnchor :: Assertion+caseCountScalarsWithAnchor =+ caseHelper yamlString isScalarA 1+ where+ yamlString = "foo:\n - &anchor bin1\n - bin2\n - bin3"+ isScalarA (Y.EventScalar _ _ _ (Just _)) = True+ isScalarA _ = False++caseCountSequencesWithAnchor :: Assertion+caseCountSequencesWithAnchor =+ caseHelper yamlString isSequenceStartA 1+ where+ yamlString = "foo: &anchor\n - bin1\n - bin2\n - bin3"+ isSequenceStartA (Y.EventSequenceStart (Just _)) = True+ isSequenceStartA _ = False++caseCountMappingsWithAnchor :: Assertion+caseCountMappingsWithAnchor =+ caseHelper yamlString isMappingA 1+ where+ yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3"+ isMappingA (Y.EventMappingStart (Just _)) = True+ isMappingA _ = False++caseCountAliases :: Assertion+caseCountAliases =+ caseHelper yamlString isAlias 1+ where+ yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3\nboo: *anchor"+ isAlias Y.EventAlias{} = True+ isAlias _ = False++caseCountScalars :: Assertion+caseCountScalars = do+ res <- C.runResourceT $ Y.decode yamlBS C.$$ CL.fold adder accum+ res @?= (7, 1, 2)+ where+ yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"+ yamlBS = B8.pack yamlString+ adder (s, l, m) (Y.EventScalar{}) = (s + 1, l, m)+ adder (s, l, m) (Y.EventSequenceStart{}) = (s, l + 1, m)+ adder (s, l, m) (Y.EventMappingStart{}) = (s, l, m + 1)+ adder a _ = a+ accum = (0, 0, 0) :: (Int, Int, Int)++caseLargestString :: Assertion+caseLargestString = do+ res <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.fold adder accum+ res @?= (length expected, expected)+ where+ expected = "this one is just a little bit bigger than the others"+ filePath = "test/largest-string.yaml"+ adder (i, s) (Y.EventScalar bs _ _ _) =+ let s' = B8.unpack bs+ i' = length s'+ in if i' > i then (i', s') else (i, s)+ adder acc _ = acc+ accum = (0, "no strings found")++newtype MyEvent = MyEvent Y.Event deriving Show+instance Eq MyEvent where+ (MyEvent (Y.EventScalar s t _ _)) == (MyEvent (Y.EventScalar s' t' _ _)) =+ s == s' && t == t'+ MyEvent e1 == MyEvent e2 = e1 == e2++caseEncodeDecode :: Assertion+caseEncodeDecode = do+ eList <- C.runResourceT $ Y.decode yamlBS C.$$ CL.consume+ bs <- C.runResourceT $ CL.sourceList eList C.$$ Y.encode+ eList2 <- C.runResourceT $ Y.decode bs C.$$ CL.consume+ map MyEvent eList @=? map MyEvent eList2+ where+ yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"+ yamlBS = B8.pack yamlString++removeFile' :: FilePath -> IO ()+removeFile' fp = do+ x <- doesFileExist fp+ when x $ removeFile fp++caseEncodeDecodeFile :: Assertion+caseEncodeDecodeFile = do+ removeFile' tmpPath+ eList <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.consume+ C.runResourceT $ CL.sourceList eList C.$$ Y.encodeFile tmpPath+ eList2 <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.consume+ map MyEvent eList @=? map MyEvent eList2+ where+ filePath = "test/largest-string.yaml"+ tmpPath = "tmp.yaml"++caseInterleave :: Assertion+caseInterleave = do+ removeFile' tmpPath+ removeFile' tmpPath2+ () <- C.runResourceT $ Y.decodeFile filePath C.$$ Y.encodeFile tmpPath+ () <- C.runResourceT $ Y.decodeFile tmpPath C.$$ Y.encodeFile tmpPath2+ f1 <- readFile tmpPath+ f2 <- readFile tmpPath2+ f1 @=? f2+ where+ filePath = "test/largest-string.yaml"+ tmpPath = "tmp.yaml"+ tmpPath2 = "tmp2.yaml"++caseDecodeInvalidDocument :: Assertion+caseDecodeInvalidDocument = do+ x <- try $ C.runResourceT $ Y.decode yamlBS C.$$ CL.sinkNull+ case x of+ Left (_ :: SomeException) -> return ()+ Right y -> do+ putStrLn $ "bad return value: " ++ show y+ assertFailure "expected parsing exception, but got no errors"+ where+ yamlString = " - foo\n - baz\nbuz"+ yamlBS = B8.pack yamlString++mkScalar :: String -> D.Value+mkScalar = mkStrScalar++mkStrScalar :: String -> D.Value+mkStrScalar = D.String . T.pack++mappingKey :: D.Value-> String -> D.Value+mappingKey (D.Object m) k = (fromJust . M.lookup (T.pack k) $ m)+mappingKey _ _ = error "expected Object"++decodeYaml :: String -> Maybe D.Value+decodeYaml s = D.decode $ B8.pack s++sample :: D.Value+sample = array+ [ D.String "foo"+ , object+ [ ("bar1", D.String "bar2")+ , ("bar3", D.String "")+ ]+ , D.String ""+ ]++caseEncodeDecodeData :: Assertion+caseEncodeDecodeData = do+ let out = D.decode $ D.encode sample+ out @?= Just sample++caseEncodeDecodeFileData :: Assertion+caseEncodeDecodeFileData = do+ let fp = "tmp.yaml"+ D.encodeFile fp sample+ out <- D.decodeFile fp+ out @?= Just sample++caseEncodeDecodeStrings :: Assertion+caseEncodeDecodeStrings = do+ let out = D.decode $ D.encode sample+ out @?= Just sample++caseDecodeInvalid :: Assertion+caseDecodeInvalid = do+ let invalid = B8.pack "\tthis is 'not' valid :-)"+ Nothing @=? (D.decode invalid :: Maybe D.Value)++caseSimpleScalarAlias :: Assertion+caseSimpleScalarAlias = do+ let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch"+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"+ let res = fromJust maybeRes+ res @?= array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo")]++caseSimpleSequenceAlias :: Assertion+caseSimpleSequenceAlias = do+ let maybeRes = decodeYaml "seq: &anch\n - foo\n - baz\nseq2: *anch"+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"+ let res = fromJust maybeRes+ res @?= object [("seq", array [(mkScalar "foo"), (mkScalar "baz")]), ("seq2", array [(mkScalar "foo"), (mkScalar "baz")])]++caseSimpleMappingAlias :: Assertion+caseSimpleMappingAlias = do+ let maybeRes = decodeYaml "map: &anch\n key1: foo\n key2: baz\nmap2: *anch"+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"+ let res = fromJust maybeRes+ res @?= object [(T.pack "map", object [("key1", mkScalar "foo"), ("key2", (mkScalar "baz"))]), (T.pack "map2", object [("key1", (mkScalar "foo")), ("key2", mkScalar "baz")])]++caseMappingAliasBeforeAnchor :: Assertion+caseMappingAliasBeforeAnchor = do+ let res = decodeYaml "map: *anch\nmap2: &anch\n key1: foo\n key2: baz"+ isNothing res @? "decode should return Nothing due to unknown alias"++caseMappingAliasInsideAnchor :: Assertion+caseMappingAliasInsideAnchor = do+ let res = decodeYaml "map: &anch\n key1: foo\n key2: *anch"+ isNothing res @? "decode should return Nothing due to unknown alias"++caseScalarAliasOverriding :: Assertion+caseScalarAliasOverriding = do+ let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch\n- &anch boo\n- buz\n- *anch"+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"+ let res = fromJust maybeRes+ res @?= array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo"), (mkScalar "boo"), (mkScalar "buz"), (mkScalar "boo")]++caseAllKeysShouldBeUnique :: Assertion+caseAllKeysShouldBeUnique = do+ let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\nfoo1: buz"+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"+ let res = fromJust maybeRes+ mappingKey res "foo1" @?= (mkScalar "buz")++caseSimpleMappingMerge :: Assertion+caseSimpleMappingMerge = do+ let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\n<<:\n foo1: buz\n foo3: fuz"+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"+ let res = fromJust maybeRes+ mappingKey res "foo1" @?= (mkScalar "foo")+ mappingKey res "foo3" @?= (mkScalar "fuz")++caseMergeSequence :: Assertion+caseMergeSequence = do+ let maybeRes = decodeYaml "m1: &m1\n k1: !!str 1\n k2: !!str 2\nm2: &m2\n k1: !!str 3\n k3: !!str 4\nfoo1: foo\n<<: [ *m1, *m2 ]"+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"+ let res = fromJust maybeRes+ mappingKey res "foo1" @?= (mkScalar "foo")+ mappingKey res "k1" @?= (D.String "1")+ mappingKey res "k2" @?= (D.String "2")+ mappingKey res "k3" @?= (D.String "4")++caseDataTypes :: Assertion+caseDataTypes =+ D.decode (D.encode val) @?= Just val+ where+ val = object+ [ ("string", D.String "foo")+ , ("int", D.Number 5)+ , ("float", D.Number 4.3)+ , ("true", D.Bool True)+ , ("false", D.Bool False)+ , ("null", D.Null)+ ]++caseQuotedNumber, caseUnquotedNumber, caseAttribNumber, caseIntegerDecimals :: Assertion+caseQuotedNumber = D.decode "foo: \"1234\"" @?= Just (object [("foo", D.String "1234")])+caseUnquotedNumber = D.decode "foo: 1234" @?= Just (object [("foo", D.Number 1234)])+caseAttribNumber = D.decode "foo: !!str 1234" @?= Just (object [("foo", D.String "1234")])+caseIntegerDecimals = D.encode (1 :: Int) @?= "1\n...\n"++obj :: Maybe D.Value+obj = Just (object [("foo", D.Bool False), ("bar", D.Bool True), ("baz", D.Bool True)])++caseLowercaseBool, caseUppercaseBool, caseTitlecaseBool :: Assertion+caseLowercaseBool = D.decode "foo: off\nbar: y\nbaz: true" @?= obj+caseUppercaseBool = D.decode "foo: FALSE\nbar: Y\nbaz: ON" @?= obj+caseTitlecaseBool = D.decode "foo: No\nbar: Yes\nbaz: True" @?= obj++caseEmptyInput :: Assertion+caseEmptyInput = D.decode B8.empty @?= (Nothing :: Maybe D.Value)++checkNull :: T.Text -> Spec+checkNull x =+ it ("null recognized: " ++ show x) assertion+ where+ assertion = Just (object [("foo", D.Null)]) @=? D.decode (B8.pack $ "foo: " ++ T.unpack x)++caseStripAlias :: Assertion+caseStripAlias =+ D.decode src @?= Just (object+ [ "Default" .= object+ [ "foo" .= (1 :: Int)+ , "bar" .= (2 :: Int)+ ]+ , "Obj" .= object+ [ "foo" .= (1 :: Int)+ , "bar" .= (2 :: Int)+ , "key" .= (3 :: Int)+ ]+ ])+ where+ src = "Default: &def\n foo: 1\n bar: 2\nObj:\n <<: *def\n key: 3\n"++caseIssue49 :: Assertion+caseIssue49 =+ D.decodeEither src @?= Right (object+ [ "a" .= object [ "value" .= (1.0 :: Double) ]+ , "b" .= object [ "value" .= (1.2 :: Double) ]+ ])+ where+ src = "---\na:\n &id5 value: 1.0\nb:\n *id5: 1.2"
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
− test/main.hs
@@ -1,438 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}--import qualified Text.Libyaml as Y-import qualified Data.ByteString.Char8 as B8--import Test.HUnit hiding (Test, path)--import qualified Data.Conduit as C-import qualified Control.Monad.Trans.Resource as C-import qualified Data.Conduit.List as CL--import System.Directory-import Control.Monad-import Control.Exception (try, SomeException)-import Test.Hspec--import qualified Data.Yaml as D-import Data.Yaml (object, array, (.=))-import Data.Maybe-import qualified Data.HashMap.Strict as M-import qualified Data.Text as T-import Data.Aeson.TH-import Data.Text (Text)-import Data.Vector (Vector)-import qualified Data.Vector as V-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM--data TestJSON = TestJSON- { string :: Text- , number :: Int- , anArray :: Vector Text- , hash :: HashMap Text Text- , extrastring :: Text- } deriving (Show, Eq)--deriveJSON defaultOptions ''TestJSON--main :: IO ()-main = hspec $ do- describe "streaming" $ do- it "count scalars with anchor" caseCountScalarsWithAnchor- it "count sequences with anchor" caseCountSequencesWithAnchor- it "count mappings with anchor" caseCountMappingsWithAnchor- it "count aliases" caseCountAliases- it "count scalars" caseCountScalars- it "largest string" caseLargestString- it "encode/decode" caseEncodeDecode- it "encode/decode file" caseEncodeDecodeFile- it "interleaved encode/decode" caseInterleave- it "decode invalid document (without segfault)" caseDecodeInvalidDocument- describe "Data.Yaml" $ do- it "encode/decode" caseEncodeDecodeData- it "encode/decode file" caseEncodeDecodeFileData- it "encode/decode strings" caseEncodeDecodeStrings- it "decode invalid file" caseDecodeInvalid- it "processes datatypes" caseDataTypes- describe "Data.Yaml aliases" $ do- it "simple scalar alias" caseSimpleScalarAlias- it "simple sequence alias" caseSimpleSequenceAlias- it "simple mapping alias" caseSimpleMappingAlias- it "mapping alias before anchor" caseMappingAliasBeforeAnchor- it "mapping alias inside anchor" caseMappingAliasInsideAnchor- it "scalar alias overriding" caseScalarAliasOverriding- describe "Data.Yaml merge keys" $ do- it "test uniqueness of keys" caseAllKeysShouldBeUnique- it "test mapping merge" caseSimpleMappingMerge- it "test sequence of mappings merging" caseMergeSequence- describe "numbers" $ do- it "parses as string when quoted" caseQuotedNumber- it "parses as number when unquoted" caseUnquotedNumber- it "parses as number !!str is present" caseAttribNumber- it "integers have no decimals" caseIntegerDecimals- describe "booleans" $ do- it "parses when all lowercase" caseLowercaseBool- it "parses when all uppercase" caseUppercaseBool- it "parses when titlecase" caseTitlecaseBool- describe "empty input" $ do- it "doesn't crash" caseEmptyInput- describe "alias stripping" $ do- it "works" caseStripAlias- describe "nulls" $ do- checkNull "null"- checkNull "Null"- checkNull "NULL"- checkNull "~"- checkNull ""-- describe "pretty output" $ do- it "simple nulls" $ D.encode (object ["foo" .= D.Null]) `shouldBe` "foo: null\n"- it "simple numbers" $ D.encode (object ["foo" .= (4 :: Int)]) `shouldBe` "foo: 4\n"- it "True" $ D.encode (object ["foo" .= True]) `shouldBe` "foo: true\n"- it "False" $ D.encode (object ["foo" .= False]) `shouldBe` "foo: false\n"- it "simple string" $ D.encode (object ["foo" .= ("bar" :: T.Text)]) `shouldBe` "foo: bar\n"-- describe "special keys" $ do- let tester key = it (T.unpack key) $- let value = object [key .= True]- in D.decode (D.encode value) `shouldBe` Just value- mapM_ tester specialStrings-- describe "special values" $ do- let tester value = it (T.unpack value) $- let value' = object ["foo" .= value]- in D.decode (D.encode value') `shouldBe` Just value'- mapM_ tester specialStrings-- describe "yamlFileJSONparse" $- it "loads YAML through JSON into Haskell data" $ do- tj <- either (error . show) id `fmap` D.decodeFileEither "test/json.yaml"- tj `shouldBe` TestJSON- { string = "str"- , number = 2- , anArray = V.fromList ["a", "b"]- , hash = HM.fromList [("key1", "value1"), ("key2", "value2")]- , extrastring = "1234-foo"- }-- describe "round-tripping of special scalars" $ do- let special = words "y Y On ON false 12345 12345.0 12345a 12e3"- forM_ special $ \w -> it w $- let v = object ["word" .= w]- in D.decode (D.encode v) `shouldBe` Just v- it "no tags" $ D.encode (object ["word" .= ("true" :: String)]) `shouldBe` "word: 'true'\n"-- it "aliases in keys #49" caseIssue49---specialStrings :: [T.Text]-specialStrings =- [ "fo\"o"- , "fo\'o"- , "fo\\'o"- , "fo: o"- , "foo\nbar\nbaz\n"- ]--counter :: Monad m => (Y.Event -> Bool) -> C.Sink Y.Event m Int-counter pred' =- CL.fold (\cnt e -> (if pred' e then 1 else 0) + cnt) 0--caseHelper :: String- -> (Y.Event -> Bool)- -> Int- -> Assertion-caseHelper yamlString pred' expRes = do- res <- C.runResourceT $ Y.decode (B8.pack yamlString) C.$$ counter pred'- res @?= expRes--caseCountScalarsWithAnchor :: Assertion-caseCountScalarsWithAnchor =- caseHelper yamlString isScalarA 1- where- yamlString = "foo:\n - &anchor bin1\n - bin2\n - bin3"- isScalarA (Y.EventScalar _ _ _ (Just _)) = True- isScalarA _ = False--caseCountSequencesWithAnchor :: Assertion-caseCountSequencesWithAnchor =- caseHelper yamlString isSequenceStartA 1- where- yamlString = "foo: &anchor\n - bin1\n - bin2\n - bin3"- isSequenceStartA (Y.EventSequenceStart (Just _)) = True- isSequenceStartA _ = False--caseCountMappingsWithAnchor :: Assertion-caseCountMappingsWithAnchor =- caseHelper yamlString isMappingA 1- where- yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3"- isMappingA (Y.EventMappingStart (Just _)) = True- isMappingA _ = False--caseCountAliases :: Assertion-caseCountAliases =- caseHelper yamlString isAlias 1- where- yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3\nboo: *anchor"- isAlias Y.EventAlias{} = True- isAlias _ = False--caseCountScalars :: Assertion-caseCountScalars = do- res <- C.runResourceT $ Y.decode yamlBS C.$$ CL.fold adder accum- res @?= (7, 1, 2)- where- yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"- yamlBS = B8.pack yamlString- adder (s, l, m) (Y.EventScalar{}) = (s + 1, l, m)- adder (s, l, m) (Y.EventSequenceStart{}) = (s, l + 1, m)- adder (s, l, m) (Y.EventMappingStart{}) = (s, l, m + 1)- adder a _ = a- accum = (0, 0, 0) :: (Int, Int, Int)--caseLargestString :: Assertion-caseLargestString = do- res <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.fold adder accum- res @?= (length expected, expected)- where- expected = "this one is just a little bit bigger than the others"- filePath = "test/largest-string.yaml"- adder (i, s) (Y.EventScalar bs _ _ _) =- let s' = B8.unpack bs- i' = length s'- in if i' > i then (i', s') else (i, s)- adder acc _ = acc- accum = (0, "no strings found")--newtype MyEvent = MyEvent Y.Event deriving Show-instance Eq MyEvent where- (MyEvent (Y.EventScalar s t _ _)) == (MyEvent (Y.EventScalar s' t' _ _)) =- s == s' && t == t'- MyEvent e1 == MyEvent e2 = e1 == e2--caseEncodeDecode :: Assertion-caseEncodeDecode = do- eList <- C.runResourceT $ Y.decode yamlBS C.$$ CL.consume- bs <- C.runResourceT $ CL.sourceList eList C.$$ Y.encode- eList2 <- C.runResourceT $ Y.decode bs C.$$ CL.consume- map MyEvent eList @=? map MyEvent eList2- where- yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"- yamlBS = B8.pack yamlString--removeFile' :: FilePath -> IO ()-removeFile' fp = do- x <- doesFileExist fp- when x $ removeFile fp--caseEncodeDecodeFile :: Assertion-caseEncodeDecodeFile = do- removeFile' tmpPath- eList <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.consume- C.runResourceT $ CL.sourceList eList C.$$ Y.encodeFile tmpPath- eList2 <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.consume- map MyEvent eList @=? map MyEvent eList2- where- filePath = "test/largest-string.yaml"- tmpPath = "tmp.yaml"--caseInterleave :: Assertion-caseInterleave = do- removeFile' tmpPath- removeFile' tmpPath2- () <- C.runResourceT $ Y.decodeFile filePath C.$$ Y.encodeFile tmpPath- () <- C.runResourceT $ Y.decodeFile tmpPath C.$$ Y.encodeFile tmpPath2- f1 <- readFile tmpPath- f2 <- readFile tmpPath2- f1 @=? f2- where- filePath = "test/largest-string.yaml"- tmpPath = "tmp.yaml"- tmpPath2 = "tmp2.yaml"--caseDecodeInvalidDocument :: Assertion-caseDecodeInvalidDocument = do- x <- try $ C.runResourceT $ Y.decode yamlBS C.$$ CL.sinkNull- case x of- Left (_ :: SomeException) -> return ()- Right y -> do- putStrLn $ "bad return value: " ++ show y- assertFailure "expected parsing exception, but got no errors"- where- yamlString = " - foo\n - baz\nbuz"- yamlBS = B8.pack yamlString--mkScalar :: String -> D.Value-mkScalar = mkStrScalar--mkStrScalar :: String -> D.Value-mkStrScalar = D.String . T.pack--mappingKey :: D.Value-> String -> D.Value-mappingKey (D.Object m) k = (fromJust . M.lookup (T.pack k) $ m)-mappingKey _ _ = error "expected Object"--decodeYaml :: String -> Maybe D.Value-decodeYaml s = D.decode $ B8.pack s--sample :: D.Value-sample = array- [ D.String "foo"- , object- [ ("bar1", D.String "bar2")- , ("bar3", D.String "")- ]- , D.String ""- ]--caseEncodeDecodeData :: Assertion-caseEncodeDecodeData = do- let out = D.decode $ D.encode sample- out @?= Just sample--caseEncodeDecodeFileData :: Assertion-caseEncodeDecodeFileData = do- let fp = "tmp.yaml"- D.encodeFile fp sample- out <- D.decodeFile fp- out @?= Just sample--caseEncodeDecodeStrings :: Assertion-caseEncodeDecodeStrings = do- let out = D.decode $ D.encode sample- out @?= Just sample--caseDecodeInvalid :: Assertion-caseDecodeInvalid = do- let invalid = B8.pack "\tthis is 'not' valid :-)"- Nothing @=? (D.decode invalid :: Maybe D.Value)--caseSimpleScalarAlias :: Assertion-caseSimpleScalarAlias = do- let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch"- isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"- let res = fromJust maybeRes- res @?= array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo")]--caseSimpleSequenceAlias :: Assertion-caseSimpleSequenceAlias = do- let maybeRes = decodeYaml "seq: &anch\n - foo\n - baz\nseq2: *anch"- isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"- let res = fromJust maybeRes- res @?= object [("seq", array [(mkScalar "foo"), (mkScalar "baz")]), ("seq2", array [(mkScalar "foo"), (mkScalar "baz")])]--caseSimpleMappingAlias :: Assertion-caseSimpleMappingAlias = do- let maybeRes = decodeYaml "map: &anch\n key1: foo\n key2: baz\nmap2: *anch"- isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"- let res = fromJust maybeRes- res @?= object [(T.pack "map", object [("key1", mkScalar "foo"), ("key2", (mkScalar "baz"))]), (T.pack "map2", object [("key1", (mkScalar "foo")), ("key2", mkScalar "baz")])]--caseMappingAliasBeforeAnchor :: Assertion-caseMappingAliasBeforeAnchor = do- let res = decodeYaml "map: *anch\nmap2: &anch\n key1: foo\n key2: baz"- isNothing res @? "decode should return Nothing due to unknown alias"--caseMappingAliasInsideAnchor :: Assertion-caseMappingAliasInsideAnchor = do- let res = decodeYaml "map: &anch\n key1: foo\n key2: *anch"- isNothing res @? "decode should return Nothing due to unknown alias"--caseScalarAliasOverriding :: Assertion-caseScalarAliasOverriding = do- let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch\n- &anch boo\n- buz\n- *anch"- isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"- let res = fromJust maybeRes- res @?= array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo"), (mkScalar "boo"), (mkScalar "buz"), (mkScalar "boo")]--caseAllKeysShouldBeUnique :: Assertion-caseAllKeysShouldBeUnique = do- let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\nfoo1: buz"- isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"- let res = fromJust maybeRes- mappingKey res "foo1" @?= (mkScalar "buz")--caseSimpleMappingMerge :: Assertion-caseSimpleMappingMerge = do- let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\n<<:\n foo1: buz\n foo3: fuz"- isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"- let res = fromJust maybeRes- mappingKey res "foo1" @?= (mkScalar "foo")- mappingKey res "foo3" @?= (mkScalar "fuz")--caseMergeSequence :: Assertion-caseMergeSequence = do- let maybeRes = decodeYaml "m1: &m1\n k1: !!str 1\n k2: !!str 2\nm2: &m2\n k1: !!str 3\n k3: !!str 4\nfoo1: foo\n<<: [ *m1, *m2 ]"- isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"- let res = fromJust maybeRes- mappingKey res "foo1" @?= (mkScalar "foo")- mappingKey res "k1" @?= (D.String "1")- mappingKey res "k2" @?= (D.String "2")- mappingKey res "k3" @?= (D.String "4")--caseDataTypes :: Assertion-caseDataTypes =- D.decode (D.encode val) @?= Just val- where- val = object- [ ("string", D.String "foo")- , ("int", D.Number 5)- , ("float", D.Number 4.3)- , ("true", D.Bool True)- , ("false", D.Bool False)- , ("null", D.Null)- ]--caseQuotedNumber, caseUnquotedNumber, caseAttribNumber, caseIntegerDecimals :: Assertion-caseQuotedNumber = D.decode "foo: \"1234\"" @?= Just (object [("foo", D.String "1234")])-caseUnquotedNumber = D.decode "foo: 1234" @?= Just (object [("foo", D.Number 1234)])-caseAttribNumber = D.decode "foo: !!str 1234" @?= Just (object [("foo", D.String "1234")])-caseIntegerDecimals = D.encode (1 :: Int) @?= "1\n...\n"--obj :: Maybe D.Value-obj = Just (object [("foo", D.Bool False), ("bar", D.Bool True), ("baz", D.Bool True)])--caseLowercaseBool, caseUppercaseBool, caseTitlecaseBool :: Assertion-caseLowercaseBool = D.decode "foo: off\nbar: y\nbaz: true" @?= obj-caseUppercaseBool = D.decode "foo: FALSE\nbar: Y\nbaz: ON" @?= obj-caseTitlecaseBool = D.decode "foo: No\nbar: Yes\nbaz: True" @?= obj--caseEmptyInput :: Assertion-caseEmptyInput = D.decode B8.empty @?= (Nothing :: Maybe D.Value)--checkNull :: T.Text -> Spec-checkNull x =- it ("null recognized: " ++ show x) assertion- where- assertion = Just (object [("foo", D.Null)]) @=? D.decode (B8.pack $ "foo: " ++ T.unpack x)--caseStripAlias :: Assertion-caseStripAlias =- D.decode src @?= Just (object- [ "Default" .= object- [ "foo" .= (1 :: Int)- , "bar" .= (2 :: Int)- ]- , "Obj" .= object- [ "foo" .= (1 :: Int)- , "bar" .= (2 :: Int)- , "key" .= (3 :: Int)- ]- ])- where- src = "Default: &def\n foo: 1\n bar: 2\nObj:\n <<: *def\n key: 3\n"--caseIssue49 :: Assertion-caseIssue49 =- D.decodeEither src @?= Right (object- [ "a" .= object [ "value" .= (1.0 :: Double) ]- , "b" .= object [ "value" .= (1.2 :: Double) ]- ])- where- src = "---\na:\n &id5 value: 1.0\nb:\n *id5: 1.2"
+ test/resources/bar.yaml view
@@ -0,0 +1,2 @@+one: 1+two: 2
+ test/resources/baz.yaml view
@@ -0,0 +1,1 @@+foo: !include foo.yaml
+ test/resources/foo.yaml view
@@ -0,0 +1,3 @@+foo: 23+bar: !include bar.yaml+baz: 42
+ test/resources/loop/bar.yaml view
@@ -0,0 +1,2 @@+one: 1+two: !include foo.yaml
+ test/resources/loop/foo.yaml view
@@ -0,0 +1,3 @@+foo: 23+bar: !include bar.yaml+baz: 42
yaml.cabal view
@@ -1,33 +1,29 @@ name: yaml-version: 0.8.9.4+version: 0.8.10 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>, Anton Ageev <antage@gmail.com>,Kirill Simonov maintainer: Michael Snoyman <michael@snoyman.com> synopsis: Support for parsing and rendering YAML documents.-description: Provides support for parsing and emitting Yaml documents.- .- This package includes the full libyaml C library version 0.1.2 by Kirill- Simonov (<http://pyyaml.org/wiki/LibYAML>) in the package so you- don't need to worry about any non-Haskell dependencies.- .- The package is broken down into two modules.- "Data.Yaml" provides a high-level interface based- around the JSON datatypes provided by the @aeson@- package. "Text.Libyaml" provides a lower-level,- streaming interface. For most users, "Data.Yaml" is recommended.+description: Please see the README.md file. category: Web stability: stable cabal-version: >= 1.8 build-type: Simple homepage: http://github.com/snoyberg/yaml/-extra-source-files: c/helper.h,- libyaml/yaml_private.h,- libyaml/yaml.h,- libyaml/LICENSE- test/main.hs+extra-source-files: c/helper.h+ libyaml/yaml_private.h+ libyaml/yaml.h+ libyaml/LICENSE test/largest-string.yaml test/json.yaml+ test/resources/foo.yaml+ test/resources/bar.yaml+ test/resources/baz.yaml+ test/resources/loop/foo.yaml+ test/resources/loop/bar.yaml+ README.md+ ChangeLog.md flag no-exe description: don't install the yaml2json or json2yaml executables@@ -54,11 +50,14 @@ , text , attoparsec , scientific+ , filepath+ , directory exposed-modules: Text.Libyaml Data.Yaml Data.Yaml.Aeson Data.Yaml.Builder Data.Yaml.Parser+ Data.Yaml.Include ghc-options: -Wall c-sources: c/helper.c include-dirs: c@@ -104,10 +103,12 @@ , aeson >= 0.5 -test-suite test+test-suite spec type: exitcode-stdio-1.0 hs-source-dirs: test- main-is: main.hs+ main-is: Spec.hs+ other-modules: Data.YamlSpec+ Data.Yaml.IncludeSpec cpp-options: -DTEST build-depends: hspec >= 1.3 , HUnit@@ -122,6 +123,7 @@ , unordered-containers , vector , resourcet+ , aeson-qq ghc-options: -Wall source-repository head