kdl-hs 1.1.0 → 1.1.1
raw patch · 5 files changed
+1139/−60 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- kdl-hs.cabal +2/−2
- test/KDL/Decoder/SharedSpec/Template.hs +1125/−0
- test/KDL/ParserSpec.hs +8/−4
- tools/kdl-test +0/−54
CHANGELOG.md view
@@ -1,3 +1,7 @@+## v1.1.1++* Fix running tests with sdist bundle+ ## v1.1.0 * Rename `KDL.text` to `KDL.string`
kdl-hs.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: kdl-hs-version: 1.1.0+version: 1.1.1 synopsis: KDL language parser and API description: KDL language parser and API. homepage: https://github.com/brandonchinn178/kdl-hs#readme@@ -15,10 +15,10 @@ extra-source-files: README.md CHANGELOG.md+ test/KDL/Decoder/SharedSpec/Template.hs test/KDL/__snapshots__/DecoderSpec.snap.md test/KDL/__snapshots__/ParserSpec.snap.md test/KDL/__snapshots__/RenderSpec.snap.md- tools/kdl-test source-repository head type: git
@@ -0,0 +1,1125 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DisambiguateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++-- Apostrophes confuse CPP macros+#define _APOS_(x) x'++#ifdef IS_MONAD+#define _DO_ do+#define _RETURN_(x) pure x+#define _STMT_(x) x+#endif++#ifdef IS_ARROW+#define _DO_ proc () -> do+#define _RETURN_(x) returnA -< x+#define _STMT_(x) x -< ()+#endif++#ifdef IS_ARROW+{-# LANGUAGE Arrows #-}+#endif++module KDL.Decoder.SharedSpec.MODULE_NAME (+ apiSpec,+ decodeNodeSpec,+ decodeValueSpec,+) where++import Control.Monad (forM_, unless)+import Data.Map qualified as Map+import Data.Text (Text)+import Data.Text qualified as Text+import KDL.TestUtils.AST (scrubFormat)+import KDL.TestUtils.Error (decodeErrorMsg)+import KDL.Types (+ Entry (..),+ Identifier (..),+ Node (..),+ NodeList (..),+ Value (..),+ ValueData (..),+ )+import Skeletest++#ifdef IS_MONAD+import KDL qualified+#endif++#ifdef IS_ARROW+import Control.Arrow (returnA)+import KDL.Arrow qualified as KDL+#endif++apiSpec :: Spec+apiSpec = do+ describe "NodeListDecoder" $ do+ describe "node" $ do+ it "decodes a node" $ do+ let config = "foo 1.0"+ decoder = KDL.document $ _DO_+ _STMT_(scrubFormat <$> KDL.node "foo")+ expected =+ Node+ { ann = Nothing+ , name = Identifier{value = "foo", ext = KDL.def}+ , entries =+ [ Entry+ { name = Nothing+ , value = Value{ann = Nothing, data_ = Number 1.0, ext = KDL.def}+ , ext = KDL.def+ }+ ]+ , children = Nothing+ , ext = KDL.def+ }+ KDL.decodeWith decoder config `shouldBe` Right expected++ it "decodes multiple nodes" $ do+ let config = "foo; foo"+ decoder = KDL.document $ _DO_+ _STMT_(fmap (map scrubFormat) . KDL.many $ KDL.node "foo")+ expected = [fooNode, fooNode]+ fooNode =+ Node+ { ann = Nothing+ , name = Identifier{value = "foo", ext = KDL.def}+ , entries = []+ , children = Nothing+ , ext = KDL.def+ }+ KDL.decodeWith decoder config `shouldBe` Right expected++ it "decodes nodes in any order" $ do+ let config = "foo; bar"+ decoder = KDL.document $ _DO_+ bar <- _STMT_(scrubFormat <$> KDL.node "bar")+ foo <- _STMT_(scrubFormat <$> KDL.node "foo")+ _RETURN_((bar, foo))+ expected = (node "bar", node "foo")+ node name =+ Node+ { ann = Nothing+ , name = Identifier{value = name, ext = KDL.def}+ , entries = []+ , children = Nothing+ , ext = KDL.def+ }+ KDL.decodeWith decoder config `shouldBe` Right expected++ it "fails when not enough nodes" $ do+ let config = "foo"+ decoder = KDL.document $ _DO_+ foo1 <- _STMT_(scrubFormat <$> KDL.node @Node "foo")+ foo2 <- _STMT_(scrubFormat <$> KDL.node @Node "foo")+ _RETURN_((foo1, foo2))+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: <root>"+ , " Expected another node: foo"+ ]++ -- Most behaviors tested with `node`+ describe "nodeWith" $ do+ it "decodes a node" $ do+ let config = "foo 1.0 { hello world; }"+ decodeFoo = _DO_+ arg <- _STMT_(KDL.arg @Int)+ child <- _STMT_(KDL.children $ KDL.argAt @Text "hello")+ _RETURN_((arg, child))+ decoder = KDL.document $ _DO_+ _STMT_(KDL.nodeWith "foo" decodeFoo)+ KDL.decodeWith decoder config `shouldBe` Right (1, "world")++ it "fails when node fails to parse" $ do+ let config = "foo 1.0"+ decodeFoo = _DO_+ _STMT_(KDL.arg @Text)+ decoder = KDL.document $ _DO_+ _STMT_(KDL.nodeWith "foo" decodeFoo)+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #0"+ , " Expected string, got: 1.0"+ ]++ -- Most behaviors tested with `nodeWith`+ describe "nodeWith'" $ do+ it "decodes a node with an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "(test)foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.nodeWith) "foo" anns $ KDL.arg @Int)+ KDL.decodeWith decoder config `shouldBe` Right 1++ it "decodes a node without an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.nodeWith) "foo" anns $ KDL.arg @Int)+ KDL.decodeWith decoder config `shouldBe` Right 1++ it "fails when node has unexpected annotation" $ do+ let config = "(test)foo 2"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.nodeWith) "foo" ["FOO"] $ KDL.arg @Int)+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0"+ , " Expected annotation to be one of [\"FOO\"], got: test"+ ]++ describe "remainingNodes" $ do+ it "returns all remaining nodes" $ do+ let config = "foo 1.0; foo 2.0; bar"+ decoder = KDL.document $ _DO_+ _ <- _STMT_(KDL.node @Node "foo")+ _STMT_(fmap (map scrubFormat) <$> KDL.remainingNodes)+ expected =+ Map.fromList+ [ ("foo", [fooNode2])+ , ("bar", [barNode])+ ]+ fooNode2 =+ Node+ { ann = Nothing+ , name = Identifier{value = "foo", ext = KDL.def}+ , entries =+ [ Entry+ { name = Nothing+ , value = Value{ann = Nothing, data_ = Number 2.0, ext = KDL.def}+ , ext = KDL.def+ }+ ]+ , children = Nothing+ , ext = KDL.def+ }+ barNode =+ Node+ { ann = Nothing+ , name = Identifier{value = "bar", ext = KDL.def}+ , entries = []+ , children = Nothing+ , ext = KDL.def+ }+ KDL.decodeWith decoder config `shouldBe` Right expected++ -- Most behaviors tested with `remainingNodes`+ describe "remainingNodesWith" $ do+ it "returns all remaining nodes" $ do+ let config = "foo 1.0; foo 2.0; bar"+ decodeNode = _DO_+ _STMT_(KDL.optional $ KDL.arg @Int)+ decoder = KDL.document $ _DO_+ _ <- _STMT_(KDL.node @Node "foo")+ _STMT_(KDL.remainingNodesWith decodeNode)+ expected =+ Map.fromList+ [ ("foo", [Just 2])+ , ("bar", [Nothing])+ ]+ KDL.decodeWith decoder config `shouldBe` Right expected++ it "fails when node fails to parse" $ do+ let config = "foo 1; bar 1; bar hello"+ decodeNode = _DO_+ _STMT_(KDL.arg @Int)+ decoder = KDL.document $ _DO_+ _STMT_(KDL.remainingNodesWith decodeNode)+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: bar #1 > arg #0"+ , " Expected number, got: hello"+ ]++ -- Most behaviors tested with `remainingNodesWith`+ describe "remainingNodesWith'" $ do+ it "decodes a node with an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "(test)foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.remainingNodesWith) anns $ KDL.arg @Int)+ KDL.decodeWith decoder config+ `shouldBe` (Right . Map.fromList) [("foo", [1])]++ it "decodes a node without an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.remainingNodesWith) anns $ KDL.arg @Int)+ KDL.decodeWith decoder config+ `shouldBe` (Right . Map.fromList) [("foo", [1])]++ it "fails when node has unexpected annotation" $ do+ let config = "(FOO)foo 1; (test)foo 2"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.remainingNodesWith) ["FOO"] $ KDL.arg @Int)+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #1"+ , " Expected annotation to be one of [\"FOO\"], got: test"+ ]++ describe "argAt" $ do+ it "gets argument at a node" $ do+ let config = "foo bar; hello world"+ decoder = KDL.document $ _DO_+ hello <- _STMT_(KDL.argAt @Text "hello")+ foo <- _STMT_(KDL.argAt @Text "foo")+ _RETURN_((hello, foo))+ KDL.decodeWith decoder config `shouldBe` Right ("world", "bar")++ it "fails if no node" $ do+ let config = "other_node"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAt @Int "foo")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: <root>"+ , " Expected node: foo"+ ]++ it "fails if node has no args" $ do+ let config = "foo"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAt @Int "foo")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0"+ , " Expected arg #0"+ ]++ it "fails if arg fails to parse" $ do+ let config = "foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAt @Text "foo")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #0"+ , " Expected string, got: 1"+ ]++ -- Most behaviors tested with `argAt`+ describe "argAtWith" $ do+ it "gets argument at a node" $ do+ let config = "foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAtWith "foo" $ show . (* 10) <$> KDL.number)+ KDL.decodeWith decoder config `shouldBe` Right "10.0"++ -- Most behaviors tested with `argAtWith`+ describe "argAtWith'" $ do+ it "decodes argument with an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo (test)a"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.argAtWith) "foo" anns KDL.string)+ KDL.decodeWith decoder config `shouldBe` Right "a"++ it "decodes argument without an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo a"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.argAtWith) "foo" anns KDL.string)+ KDL.decodeWith decoder config `shouldBe` Right "a"++ it "fails when argument has unexpected annotation" $ do+ let config = "foo (test)a"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.argAtWith) "foo" ["VAL"] KDL.string)+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #0"+ , " Expected annotation to be one of [\"VAL\"], got: test"+ ]++ describe "argsAt" $ do+ it "gets arguments at a node" $ do+ let config = "foo 1 2 3"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argsAt @Int "foo")+ KDL.decodeWith decoder config `shouldBe` Right [1, 2, 3]++ it "returns empty list if no node" $ do+ let config = ""+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argsAt @Int "foo")+ KDL.decodeWith decoder config `shouldBe` Right []++ it "returns empty list if node has no args" $ do+ let config = "foo"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argsAt @Int "foo")+ KDL.decodeWith decoder config `shouldBe` Right []++ it "fails if any arg fails to parse" $ do+ let config = "foo 1 asdf"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argsAt @Int "foo")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #1"+ , " Expected number, got: asdf"+ ]++ -- Most behaviors tested with `argsAt`+ describe "argsAtWith" $ do+ it "gets arguments at a node" $ do+ let config = "foo 1 2"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argsAtWith "foo" $ show . (* 10) <$> KDL.number)+ KDL.decodeWith decoder config `shouldBe` Right ["10.0", "20.0"]++ -- Most behaviors tested with `argsAtWith`+ describe "argsAtWith'" $ do+ it "decodes arguments with an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo (test)a (test)b"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.argsAtWith) "foo" anns KDL.string)+ KDL.decodeWith decoder config `shouldBe` Right ["a", "b"]++ it "decodes arguments without an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo a b"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.argsAtWith) "foo" anns KDL.string)+ KDL.decodeWith decoder config `shouldBe` Right ["a", "b"]++ it "fails when argument has unexpected annotation" $ do+ let config = "foo (VAL)a (test)b"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.argsAtWith) "foo" ["VAL"] KDL.string)+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #1"+ , " Expected annotation to be one of [\"VAL\"], got: test"+ ]++ describe "dashChildrenAt" $ do+ it "gets dash children at a node" $ do+ let config = "foo { - 1; - 2; - 3; }"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.dashChildrenAt @Int "foo")+ KDL.decodeWith decoder config `shouldBe` Right [1, 2, 3]++ it "returns empty list if no node" $ do+ let config = ""+ decoder = KDL.document $ _DO_+ _STMT_(KDL.dashChildrenAt @Int "foo")+ KDL.decodeWith decoder config `shouldBe` Right []++ it "returns empty list if node has no dash children" $ do+ forM_ ["foo", "foo {}"] $ \config -> do+ let decoder = KDL.document $ _DO_+ _STMT_(KDL.dashChildrenAt @Int "foo")+ KDL.decodeWith decoder config `shouldBe` Right []++ it "fails if dash children have multiple args" $ do+ let config = "foo { - 1 2; - 3 4; }"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.dashChildrenAt @Int "foo")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > - #0"+ , " Unexpected arg #1: 2"+ ]++ it "fails if node has non-dash children" $ do+ let config = "foo { - 1; bar 1 2 3; }"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.dashChildrenAt @Int "foo")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0"+ , " Unexpected node: bar #0"+ , " Expected another node: -"+ ]++ it "fails if any child fails to parse" $ do+ let config = "foo { - 1; - asdf; }"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.dashChildrenAt @Int "foo")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > - #1 > arg #0"+ , " Expected number, got: asdf"+ ]++ -- Most behaviors tested with `dashChildrenAt`+ describe "dashChildrenAtWith" $ do+ it "gets dash children at a node" $ do+ let config = "foo { - 1; - 2; }"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.dashChildrenAtWith "foo" $ show . (* 10) <$> KDL.number)+ KDL.decodeWith decoder config `shouldBe` Right ["10.0", "20.0"]++ -- Most behaviors tested with `dashChildrenAtWith`+ describe "dashChildrenAtWith'" $ do+ it "decodes dash children with an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo { - (test)a; - (test)b; }"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.dashChildrenAtWith) "foo" anns KDL.string)+ KDL.decodeWith decoder config `shouldBe` Right ["a", "b"]++ it "decodes dash children without an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo { - a; - b; }"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.dashChildrenAtWith) "foo" anns KDL.string)+ KDL.decodeWith decoder config `shouldBe` Right ["a", "b"]++ it "fails when child has unexpected annotation" $ do+ let config = "foo { - (test)a; }"+ decoder = KDL.document $ _DO_+ _STMT_(_APOS_(KDL.dashChildrenAtWith) "foo" ["VAL"] KDL.string)+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > - #0 > arg #0"+ , " Expected annotation to be one of [\"VAL\"], got: test"+ ]++ describe "dashNodesAt" $ do+ it "gets dash nodes at a node" $ do+ let config = "foo { - { bar; }; - { baz; }; }"+ decoder = KDL.document $ _DO_+ _STMT_(map scrubFormat <$> KDL.dashNodesAt "foo")+ expected = [node "-" [node "bar" []], node "-" [node "baz" []]]+ node name children =+ Node+ { ann = Nothing+ , name = Identifier{value = name, ext = KDL.def}+ , entries = []+ , children =+ if null children+ then Nothing+ else Just NodeList{nodes = children, ext = KDL.def}+ , ext = KDL.def+ }+ KDL.decodeWith decoder config `shouldBe` Right expected++ it "returns empty list if no node" $ do+ let config = ""+ decoder = KDL.document $ _DO_+ _STMT_(KDL.dashNodesAt @Node "foo")+ KDL.decodeWith decoder config `shouldBe` Right []++ it "returns empty list if node has no dash nodes" $ do+ forM_ ["foo", "foo {}"] $ \config -> do+ let decoder = KDL.document $ _DO_+ _STMT_(KDL.dashNodesAt @Node "foo")+ KDL.decodeWith decoder config `shouldBe` Right []++ it "fails if node has non-dash nodes" $ do+ let config = "foo { - 1; bar 1 2 3; }"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.dashNodesAt @Node "foo")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0"+ , " Unexpected node: bar #0"+ , " Expected another node: -"+ ]++ -- Most behaviors tested with `dashNodesAt`+ describe "dashNodesAtWith" $ do+ it "gets dash nodes at a node" $ do+ let config = "foo { - 1 { bar hello; }; - 2 { bar world; }; }"+ decodeChild = _DO_+ arg <- _STMT_(KDL.arg @Int)+ child <- _STMT_(KDL.children $ KDL.nodeWith "bar" $ KDL.arg @Text)+ _RETURN_((arg, child))+ decoder = KDL.document $ _DO_+ _STMT_(KDL.dashNodesAtWith "foo" decodeChild)+ KDL.decodeWith decoder config `shouldBe` Right [(1, "hello"), (2, "world")]++ it "fails if any child fails to parse" $ do+ let config = "foo { - { bar 1; }; - { bar test; }; }"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.dashNodesAtWith "foo" $ KDL.children $ KDL.argAt @Int "bar")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > - #1 > bar #0 > arg #0"+ , " Expected number, got: test"+ ]++ describe "NodeDecoder" $ do+ let decodeNode name decoder config =+ KDL.decodeWith+ ( KDL.document $ _DO_+ _STMT_(KDL.nodeWith name decoder)+ )+ config++ describe "arg" $ do+ it "decodes an argument" $ do+ let config = "foo 1 bar"+ decoder = _DO_+ arg1 <- _STMT_(KDL.arg @Int)+ arg2 <- _STMT_(KDL.arg @Text)+ _RETURN_((arg1, arg2))+ decodeNode "foo" decoder config `shouldBe` Right (1, "bar")++ it "decodes multiple arguments" $ do+ let config = "foo 1 2 3"+ decoder = _DO_+ _STMT_(KDL.many $ KDL.arg @Int)+ decodeNode "foo" decoder config `shouldBe` Right [1, 2, 3]++ it "fails if argument doesn't exist" $ do+ let config = "foo"+ decoder = _DO_+ _STMT_(KDL.arg @Int)+ decodeNode "foo" decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0"+ , " Expected arg #0"+ ]++ it "fails if argument fails to parse" $ do+ let config = "foo test"+ decoder = _DO_+ _STMT_(KDL.arg @Int)+ decodeNode "foo" decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #0"+ , " Expected number, got: test"+ ]++ it "fails if not all arguments are decoded" $ do+ let config = "foo 1 2 3"+ decoder = _DO_+ _STMT_(KDL.arg @Int)+ decodeNode "foo" decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0"+ , " Unexpected arg #1: 2"+ ]++ -- Most behaviors tested with `arg`+ describe "argWith" $ do+ it "decodes an argument" $ do+ let config = "foo bar"+ decoder = _DO_+ _STMT_(KDL.argWith KDL.string)+ decodeNode "foo" decoder config `shouldBe` Right "bar"++ -- Most behaviors tested with `argWith`+ describe "argWith'" $ do+ it "decodes argument with an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo (test)a"+ decoder = _DO_+ _STMT_(_APOS_(KDL.argWith) anns KDL.string)+ decodeNode "foo" decoder config `shouldBe` Right "a"++ it "decodes argument without an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo a"+ decoder = _DO_+ _STMT_(_APOS_(KDL.argWith) anns KDL.string)+ decodeNode "foo" decoder config `shouldBe` Right "a"++ it "fails when argument has unexpected annotation" $ do+ let config = "foo (test)a"+ decoder = _DO_+ _STMT_(_APOS_(KDL.argWith) ["VAL"] KDL.string)+ decodeNode "foo" decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #0"+ , " Expected annotation to be one of [\"VAL\"], got: test"+ ]++ it "supports backtracking annotations" $ do+ let config = "foo (l)1 (r)2"+ decodeArg =+ KDL.oneOf+ [ Left <$> KDL.argWith' ["l"] KDL.number+ , Right <$> KDL.argWith' ["r"] KDL.number+ ]+ decoder = KDL.document $ _DO_+ _STMT_(KDL.nodeWith "foo" . KDL.many $ decodeArg)+ KDL.decodeWith decoder config `shouldBe` Right [Left 1, Right 2]++ describe "prop" $ do+ it "decodes a prop" $ do+ let config = "foo test1=1 test2=hello"+ decoder = _DO_+ prop1 <- _STMT_(KDL.prop @Text "test2")+ prop2 <- _STMT_(KDL.prop @Int "test1")+ _RETURN_((prop1, prop2))+ decodeNode "foo" decoder config `shouldBe` Right ("hello", 1)++ it "can optionally decode a prop" $ do+ let config = "foo a=1"+ decoder = _DO_+ a <- _STMT_(KDL.optional $ KDL.prop @Int "a")+ b <- _STMT_(KDL.optional $ KDL.prop @Int "b")+ _RETURN_((a, b))+ decodeNode "foo" decoder config `shouldBe` Right (Just 1, Nothing)++ it "decodes last prop" $ do+ let config = "foo test=1 test=2"+ decoder = _DO_+ _STMT_(KDL.prop @Int "test")+ decodeNode "foo" decoder config `shouldBe` Right 2++ it "fails if prop doesn't exist" $ do+ let config = "foo 123"+ decoder = _DO_+ _STMT_(KDL.prop @Int "test")+ decodeNode "foo" decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0"+ , " Expected prop: test"+ ]++ it "fails if prop fails to parse" $ do+ let config = "foo hello=world"+ decoder = _DO_+ _STMT_(KDL.prop @Int "hello")+ decodeNode "foo" decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > prop hello"+ , " Expected number, got: world"+ ]++ it "fails if not all props are decoded" $ do+ let config = "foo a=1 b=2"+ decoder = _DO_+ _STMT_(KDL.prop @Int "a")+ decodeNode "foo" decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0"+ , " Unexpected prop: b=2"+ ]++ -- Most behaviors tested with `prop`+ describe "propWith" $ do+ it "decodes a prop" $ do+ let config = "foo a=1"+ decoder = _DO_+ _STMT_(KDL.propWith "a" KDL.number)+ decodeNode "foo" decoder config `shouldBe` Right 1++ -- Most behaviors tested with `propWith`+ describe "propWith'" $ do+ it "decodes prop with an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo a=(test)1"+ decoder = _DO_+ _STMT_(_APOS_(KDL.propWith) "a" anns KDL.number)+ decodeNode "foo" decoder config `shouldBe` Right 1++ it "decodes prop without an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo a=1"+ decoder = _DO_+ _STMT_(_APOS_(KDL.propWith) "a" anns KDL.number)+ decodeNode "foo" decoder config `shouldBe` Right 1++ it "fails when prop has unexpected annotation" $ do+ let config = "foo a=(test)1"+ decoder = _DO_+ _STMT_(_APOS_(KDL.propWith) "a" ["VAL"] KDL.number)+ decodeNode "foo" decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > prop a"+ , " Expected annotation to be one of [\"VAL\"], got: test"+ ]++ describe "remainingProps" $ do+ it "decodes remaining props" $ do+ let config = "foo a=1 b=2 c=3 b=4"+ decoder = _DO_+ _ <- _STMT_(KDL.prop @Int "a")+ _STMT_(KDL.remainingProps @Int)+ decodeNode "foo" decoder config+ `shouldBe` (Right . Map.fromList) [("b", 4), ("c", 3)]++ it "returns empty map if no props left" $ do+ let config = "foo a=1"+ decoder = _DO_+ _ <- _STMT_(KDL.prop @Int "a")+ _STMT_(KDL.remainingProps @Int)+ decodeNode "foo" decoder config `shouldBe` Right Map.empty++ it "fails if prop fails to parse" $ do+ let config = "foo a=1 b=1 c=2 c=test"+ decoder = _DO_+ _ <- _STMT_(KDL.prop @Int "a")+ _STMT_(KDL.remainingProps @Int)+ decodeNode "foo" decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > prop c"+ , " Expected number, got: test"+ ]++ -- Most behaviors tested with `remainingProps`+ describe "remainingPropsWith" $ do+ it "decodes remaining props" $ do+ let config = "foo a=1 b=2 c=3 b=4"+ decoder = _DO_+ _ <- _STMT_(KDL.prop @Int "a")+ _STMT_(KDL.remainingPropsWith KDL.number)+ decodeNode "foo" decoder config+ `shouldBe` (Right . Map.fromList) [("b", 4), ("c", 3)]++ -- Most behaviors tested with `remainingPropsWith`+ describe "remainingPropsWith'" $ do+ it "decodes props with an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo a=(test)1 b=(test)2"+ decoder = _DO_+ _STMT_(_APOS_(KDL.remainingPropsWith) anns KDL.number)+ decodeNode "foo" decoder config+ `shouldBe` (Right . Map.fromList) [("a", 1), ("b", 2)]++ it "decodes props without an annotation" $ do+ let testCases =+ [ []+ , ["test"]+ , ["test", "other"]+ ]+ forM_ testCases $ \anns -> do+ let config = "foo a=1 b=2"+ decoder = _DO_+ _STMT_(_APOS_(KDL.remainingPropsWith) anns KDL.number)+ decodeNode "foo" decoder config+ `shouldBe` (Right . Map.fromList) [("a", 1), ("b", 2)]++ it "fails when prop has unexpected annotation" $ do+ let config = "foo a=(VAL)1 b=(test)2"+ decoder = _DO_+ _STMT_(_APOS_(KDL.remainingPropsWith) ["VAL"] KDL.number)+ decodeNode "foo" decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > prop b"+ , " Expected annotation to be one of [\"VAL\"], got: test"+ ]++ describe "children" $ do+ it "decodes children" $ do+ let config = "foo { bar test; }"+ decoder = _DO_+ _STMT_(fmap scrubFormat . KDL.children $ KDL.node @Node "bar")+ expected =+ Node+ { ann = Nothing+ , name = Identifier{value = "bar", ext = KDL.def}+ , entries =+ [ Entry+ { name = Nothing+ , value = Value{ann = Nothing, data_ = String "test", ext = KDL.def}+ , ext = KDL.def+ }+ ]+ , children = Nothing+ , ext = KDL.def+ }+ decodeNode "foo" decoder config `shouldBe` Right expected++ it "can be re-entered" $ do+ let config = "foo { bar a; baz b; }"+ decoder = _DO_+ arg1 <- _STMT_(KDL.children $ KDL.argAt @Text "bar")+ arg2 <- _STMT_(KDL.children $ KDL.argAt @Text "baz")+ _RETURN_((arg1, arg2))+ decodeNode "foo" decoder config `shouldBe` Right ("a", "b")++ it "fails if not all children are decoded" $ do+ let config = "foo { asdf; bar; }"+ decoder = _DO_+ _STMT_(KDL.children $ KDL.node @Node "bar")+ decodeNode "foo" decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0"+ , " Unexpected node: asdf #0"+ ]++ describe "ValueDecoder" $ do+ describe "any" $ do+ it "decodes any value" $ do+ let config = "foo 1.0 asdf #true"+ decoder = KDL.document $ _DO_+ _STMT_(map scrubFormat <$> KDL.argsAtWith "foo" KDL.any)+ val data_ =+ Value+ { ann = Nothing+ , data_ = data_+ , ext = KDL.def+ }+ KDL.decodeWith decoder config+ `shouldBe` Right [val $ Number 1, val $ String "asdf", val $ Bool True]++ describe "string" $ do+ it "decodes string value" $ do+ let config = "foo asdf"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAtWith "foo" KDL.string)+ KDL.decodeWith decoder config `shouldBe` Right "asdf"++ it "fails when value is not string" $ do+ let config = "foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAtWith "foo" KDL.string)+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #0"+ , " Expected string, got: 1"+ ]++ describe "number" $ do+ it "decodes number value" $ do+ let config = "foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAtWith "foo" KDL.number)+ KDL.decodeWith decoder config `shouldBe` Right 1++ it "fails when value is not number" $ do+ let config = "foo asdf"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAtWith "foo" KDL.number)+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #0"+ , " Expected number, got: asdf"+ ]++ describe "bool" $ do+ it "decodes bool value" $ do+ let config = "foo #true"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAtWith "foo" KDL.bool)+ KDL.decodeWith decoder config `shouldBe` Right True++ it "fails when value is not bool" $ do+ let config = "foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAtWith "foo" KDL.bool)+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #0"+ , " Expected bool, got: 1"+ ]++ describe "null" $ do+ it "decodes null value" $ do+ let config = "foo #null"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAtWith "foo" KDL.null)+ KDL.decodeWith decoder config `shouldBe` Right ()++ it "fails when value is not null" $ do+ let config = "foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAtWith "foo" KDL.null)+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #0"+ , " Expected null, got: 1"+ ]++ describe "Combinators" $ do+ describe "oneOf" $ do+ it "decodes one of the options" $ do+ let config = "foo 123 hello"+ decodeVal = [Left <$> KDL.number, Right <$> KDL.string]+ decoder = KDL.document $ _DO_+ _STMT_(KDL.nodeWith "foo" . KDL.many . KDL.argWith $ KDL.oneOf decodeVal)+ KDL.decodeWith decoder config `shouldBe` Right [Left 123, Right "hello"]++ it "fails if none can be decoded" $ do+ let config = "foo 123 hello"+ decodeVal = [Left <$> KDL.number, Right <$> KDL.bool]+ decoder = KDL.document $ _DO_+ _STMT_(KDL.nodeWith "foo" . KDL.many . KDL.argWith $ KDL.oneOf decodeVal)+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #1"+ , " Expected bool, got: hello"+ , " Expected number, got: hello"+ ]++ describe "option" $ do+ it "defaults to the given value" $ do+ let config = "foo"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.nodeWith "foo" $ KDL.option 123 $ KDL.arg @Int)+ KDL.decodeWith decoder config `shouldBe` Right 123++newtype MyNode = MyNode Int+ deriving (Eq)++instance KDL.DecodeNode MyNode where+ validNodeTypeAnns _ = ["MyNode"]+ nodeDecoder = _DO_+ x <- _STMT_(KDL.arg)+#ifdef IS_ARROW+ if not (0 < x && x < 10)+ then KDL.fail -< "Invalid argument: " <> (Text.pack . show) x+ else returnA -< ()+ returnA -< MyNode x+#endif+#ifdef IS_MONAD+ unless (0 < x && x < 10) $ do+ KDL.fail $ "Invalid argument: " <> (Text.pack . show) x+ pure $ MyNode x+#endif++decodeNodeSpec :: Spec+decodeNodeSpec = do+ describe "DecodeNode" $ do+ it "decodes a custom node" $ do+ let config = "foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.node "foo")+ KDL.decodeWith decoder config `shouldBe` Right (MyNode 1)++ it "throws user-specified error" $ do+ let config = "foo 100"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.node @MyNode "foo")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0"+ , " Invalid argument: 100"+ ]++ it "decodes valid type ann" $ do+ let config = "(MyNode)foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.node "foo")+ KDL.decodeWith decoder config `shouldBe` Right (MyNode 1)++ it "fails on invalid type ann" $ do+ let config = "(bad)foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.node @MyNode "foo")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0"+ , " Expected annotation to be one of [\"MyNode\"], got: bad"+ ]++newtype MyVal = MyVal Double+ deriving (Eq)++instance KDL.DecodeValue MyVal where+ validValueTypeAnns _ = ["MyVal"]+ valueDecoder = KDL.withDecoder KDL.number $ \x -> do+ unless (0 < x && x < 10) $ do+ KDL.failM $ "Invalid value: " <> (Text.pack . show) x+ pure $ MyVal (realToFrac x)++decodeValueSpec :: Spec+decodeValueSpec = do+ describe "DecodeValue" $ do+ it "decodes a custom value" $ do+ let config = "foo 1"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAt "foo")+ KDL.decodeWith decoder config `shouldBe` Right (MyVal 1)++ it "throws user-specified error" $ do+ let config = "foo 100.0"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAt @MyVal "foo")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #0"+ , " Invalid value: 100.0"+ ]++ it "decodes valid type ann" $ do+ let config = "foo (MyVal)1"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAt "foo")+ KDL.decodeWith decoder config `shouldBe` Right (MyVal 1)++ it "fails on invalid type ann" $ do+ let config = "foo (bad)1"+ decoder = KDL.document $ _DO_+ _STMT_(KDL.argAt @MyVal "foo")+ KDL.decodeWith decoder config+ `shouldSatisfy` decodeErrorMsg+ [ "At: foo #0 > arg #0"+ , " Expected annotation to be one of [\"MyVal\"], got: bad"+ ]
test/KDL/ParserSpec.hs view
@@ -9,7 +9,7 @@ import KDL qualified import Skeletest import Skeletest.Predicate qualified as P-import System.Directory (findExecutable, listDirectory)+import System.Directory (doesFileExist, findExecutable, listDirectory) import System.FilePath (takeExtension, (</>)) import System.IO.Temp (withSystemTempDirectory) import System.IO.Unsafe (unsafePerformIO)@@ -46,7 +46,7 @@ -- tested in `parse` actual `shouldBe` expected - (if dotSlashInstalled then id else skip "dotslash not installed") . describe "kdl-test examples" $ do+ (if runKdlTest then id else skip "cannot run kdl-test") . describe "kdl-test examples" $ do it "decodes correctly" $ do decoder <- findExecutable "kdl-hs-test-decoder" >>= maybe (error "Could not find kdl-hs-test-decoder") pure callProcess "tools/kdl-test" ["run", "--decoder", decoder]@@ -61,5 +61,9 @@ content <- Text.readFile (dir </> "valid" </> file) (fmap KDL.render . KDL.parse) content `shouldBe` Right content -dotSlashInstalled :: Bool-dotSlashInstalled = unsafePerformIO $ isJust <$> findExecutable "dotslash"+runKdlTest :: Bool+runKdlTest = unsafePerformIO $ do+ -- Not included in sdist because sdist doesn't preserve executable perms+ scriptExists <- doesFileExist "tools/kdl-test"+ dotslashInstalled <- isJust <$> findExecutable "dotslash"+ pure $ scriptExists && dotslashInstalled
− tools/kdl-test
@@ -1,54 +0,0 @@-#!/usr/bin/env dotslash-{- "name": "kdl-test-0.2.0",- "platforms": {- "linux-x86_64": {- "size": 583741,- "hash": "sha256",- "digest": "1627ea50594c7c322ed5c7fb0d0063b2ac20a7a9460acc9363fa1777c92364c3",- "format": "tar.gz",- "path": "kdl-test",- "providers": [- {- "url": "https://github.com/brandonchinn178/kdl-test/releases/download/v0.2.0/kdl-test-0.2.0-linux-x86_64.tar.gz"- }- ]- },- "linux-aarch64": {- "size": 568646,- "hash": "sha256",- "digest": "f3ecbdb2225b6abc0d69a451be76eca4d095d835ee2e7830a880b4bfa051e6ee",- "format": "tar.gz",- "path": "kdl-test",- "providers": [- {- "url": "https://github.com/brandonchinn178/kdl-test/releases/download/v0.2.0/kdl-test-0.2.0-linux-arm64.tar.gz"- }- ]- },- "macos-x86_64": {- "size": 555773,- "hash": "sha256",- "digest": "2d66b5409889992554dbd9bf04c2817552b2c0416a2793204e2e4eea06bc4da4",- "format": "tar.gz",- "path": "kdl-test",- "providers": [- {- "url": "https://github.com/brandonchinn178/kdl-test/releases/download/v0.2.0/kdl-test-0.2.0-darwin-x86_64.tar.gz"- }- ]- },- "macos-aarch64": {- "size": 529715,- "hash": "sha256",- "digest": "abfcade1d1ce02810dc155b95ef0720e9c679d62cf50c7ab5400741909978eb2",- "format": "tar.gz",- "path": "kdl-test",- "providers": [- {- "url": "https://github.com/brandonchinn178/kdl-test/releases/download/v0.2.0/kdl-test-0.2.0-darwin-arm64.tar.gz"- }- ]- }- }-}