{-# LANGUAGE NamedFieldPuns #-} import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) import Data.Maybe import qualified Data.ByteString.Char8 as B8 import Data.Convertible.Text (cs) import qualified Text.Libyaml as LY import Data.Object import Data.Object.Yaml import Control.Monad mkFoldedScalar :: String -> YamlScalar mkFoldedScalar s = YamlScalar (cs s) LY.StrTag LY.Folded mkScalar :: String -> YamlScalar mkScalar s = YamlScalar (cs s) LY.NoTag LY.Plain mkStrScalar :: String -> YamlScalar mkStrScalar s = YamlScalar (cs s) LY.StrTag LY.Plain mappingKey :: YamlObject -> String -> YamlObject mappingKey (Mapping m) k = (fromJust . lookup (mkScalar k) $ m) mappingKey _ _ = error "expected Mapping" decodeYaml :: String -> Maybe YamlObject decodeYaml s = decode $ B8.pack s sample :: YamlObject sample = Sequence [ Scalar $ mkFoldedScalar "foo" , Mapping [ (mkFoldedScalar "bar1", Scalar $ mkFoldedScalar "bar2") ] ] sampleStr :: Object String String sampleStr = mapKeysValues fromYamlScalar fromYamlScalar sample main :: IO () main = defaultMain [ testSuite , testSuiteOfAliases , testSuiteOfMergeKeys ] testSuite :: Test testSuite = testGroup "Data.Object.Yaml" [ testCase "encode/decode" caseEncodeDecode , testCase "encode/decode file" caseEncodeDecodeFile , testCase "encode/decode strings" caseEncodeDecodeStrings , testCase "decode invalid file" caseDecodeInvalid , testCase "encode/decode in order" caseInOrder ] caseEncodeDecode :: Assertion caseEncodeDecode = do out <- decode $ encode sample out @?= sample caseEncodeDecodeFile :: Assertion caseEncodeDecodeFile = do let fp = "tmp.yaml" encodeFile fp sample out <- join $ decodeFile fp out @?= sample caseEncodeDecodeStrings :: Assertion caseEncodeDecodeStrings = do out <- decode $ encode $ toYamlObject sampleStr fromYamlObject out @?= sampleStr caseDecodeInvalid :: Assertion caseDecodeInvalid = do let invalid = B8.pack "\tthis is 'not' valid :-)" Nothing @=? (decode invalid :: Maybe YamlObject) testSuiteOfAliases :: Test testSuiteOfAliases = testGroup "Tests of aliases" [ testCase "simple scalar alias" caseSimpleScalarAlias , testCase "simple sequence alias" caseSimpleSequenceAlias , testCase "simple mapping alias" caseSimpleMappingAlias , testCase "mapping alias before anchor" caseMappingAliasBeforeAnchor , testCase "mapping alias inside anchor" caseMappingAliasInsideAnchor , testCase "scalar alias overriding" caseScalarAliasOverriding ] 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 @?= Sequence [Scalar (mkScalar "foo"), Scalar (mkScalar "baz"), Scalar (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 @?= Mapping [(mkScalar "seq", Sequence [Scalar (mkScalar "foo"), Scalar (mkScalar "baz")]), (mkScalar "seq2", Sequence [Scalar (mkScalar "foo"), Scalar (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 @?= Mapping [(mkScalar "map", Mapping [(mkScalar "key1", Scalar (mkScalar "foo")), (mkScalar "key2", Scalar (mkScalar "baz"))]), (mkScalar "map2", Mapping [(mkScalar "key1", Scalar (mkScalar "foo")), (mkScalar "key2", Scalar (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 @?= Sequence [Scalar (mkScalar "foo"), Scalar (mkScalar "baz"), Scalar (mkScalar "foo"), Scalar (mkScalar "boo"), Scalar (mkScalar "buz"), Scalar (mkScalar "boo")] testSuiteOfMergeKeys :: Test testSuiteOfMergeKeys = testGroup "Tests of 'merge keys' feature" [ testCase "test uniqueness of keys" caseAllKeysShouldBeUnique , testCase "test mapping merge" caseSimpleMappingMerge , testCase "test sequence of mappings merging" caseMergeSequence ] 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" @?= Scalar (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" @?= Scalar (mkScalar "foo") mappingKey res "foo3" @?= Scalar (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" @?= Scalar (mkScalar "foo") mappingKey res "k1" @?= Scalar (mkStrScalar "1") mappingKey res "k2" @?= Scalar (mkStrScalar "2") mappingKey res "k3" @?= Scalar (mkStrScalar "4") inOrderData :: String inOrderData = "'Fatal': 'Unknown variable \"bar\"'\n'Date': '2001-11-23 15:03:17 -5'\n'User': 'ed'\n'Stack':\n- 'line': '23'\n 'file': 'TopClass.py'\n 'code': 'x = MoreObject(\"345\\n\")\n\n'\n- 'line': '58'\n 'file': 'MoreClass.py'\n 'code': 'foo = bar'\n" inOrderData2 :: String inOrderData2 = "'a': '1'\n'b': '2'\n'd': '4'\n'c': '3'\n" ++ "'g': '1'\n'n': '2'\n'q': '4'\n'f': '3'\n" ++ "'z': '1'\n'y': '2'\n'x': '4'\n'w': '3'\n" caseInOrder :: Assertion caseInOrder = do Just (Mapping ((x, _):_)) <- return $ decodeYaml inOrderData x @?= mkScalar "Fatal" fmap (B8.unpack . encode) (decodeYaml inOrderData2) @?= Just inOrderData2