kdl-hs-1.1.1: test/KDL/Decoder/SharedSpec/Template.hs
{-# 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"
]