kdl-hs/test/KDL/ApplicativeSpec.hs at 7a008cade14aa8f07234c135f7e612275389b9a2 · brandonchinn178/kdl-hs · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QualifiedDo #-}

module KDL.ApplicativeSpec (spec) where

import Data.Int (Int64)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Data.Typeable (typeRep)
import KDL.Applicative qualified as KDL
import KDL.Arrow ((>>>), (|||))
import KDL.Arrow qualified
import Skeletest

spec :: Spec
spec = do
  describe "documentSchema" $ do
    it "gets the schema of a decoder" $ do
      let decoder = KDL.document $ KDL.do
            x <-
              KDL.nodeWith "foo" $
                fmap show . KDL.argWith $
                  KDL.oneOf
                    [ Left <$> KDL.valueDecoder @Bool
                    , Right <$> KDL.valueDecoder @Text
                    ]

            ys <- KDL.many $ KDL.nodeWith "bar" $ KDL.arg @String

            z <- (parseBazType <$> KDL.argAt @Text "baz_type") >>> KDL.argAtWith "baz" decodeBaz

            pure (x, ys, z)
          parseBazType = \case
            "int" -> Left $ ()
            "bool" -> Right . Left $ ()
            ty -> Right . Right $ "Invalid type: " <> ty
          decodeBaz =
            -- "int"
            KDL.valueDecoder @Int64
              -- "bool"
              ||| ((\b -> if b then 1 else 0) <$> KDL.valueDecoder @Bool)
              -- else
              ||| KDL.Arrow.fail
          expected =
            KDL.SchemaAnd
              [ KDL.SchemaOne . KDL.NodeNamed "foo" $
                  KDL.TypedNodeSchema
                    { typeHint = typeRep $ Proxy @String
                    , validTypeAnns = []
                    , nodeSchema =
                        KDL.SchemaOne . KDL.NodeArg $
                          KDL.TypedValueSchema
                            { typeHint = typeRep $ Proxy @(Either Bool Text)
                            , validTypeAnns = []
                            , dataSchema =
                                KDL.SchemaOr
                                  [ KDL.SchemaOne KDL.BoolSchema
                                  , KDL.SchemaOne KDL.TextSchema
                                  ]
                            }
                    }
              , KDL.SchemaOr
                  [ KDL.SchemaSome . KDL.SchemaOne . KDL.NodeNamed "bar" $
                      KDL.TypedNodeSchema
                        { typeHint = typeRep $ Proxy @String
                        , validTypeAnns = []
                        , nodeSchema =
                            KDL.SchemaOne . KDL.NodeArg $
                              KDL.TypedValueSchema
                                { typeHint = typeRep $ Proxy @String
                                , validTypeAnns = ["string"]
                                , dataSchema = KDL.SchemaOne KDL.TextSchema
                                }
                        }
                  , KDL.SchemaAnd []
                  ]
              , KDL.SchemaOne . KDL.NodeNamed "baz_type" $
                  KDL.TypedNodeSchema
                    { typeHint = typeRep $ Proxy @Text
                    , validTypeAnns = []
                    , nodeSchema =
                        KDL.SchemaOne . KDL.NodeArg $
                          KDL.TypedValueSchema
                            { typeHint = typeRep $ Proxy @Text
                            , validTypeAnns = ["string"]
                            , dataSchema = KDL.SchemaOne KDL.TextSchema
                            }
                    }
              , KDL.SchemaOne . KDL.NodeNamed "baz" $
                  KDL.TypedNodeSchema
                    { typeHint = typeRep $ Proxy @Int64
                    , validTypeAnns = []
                    , nodeSchema =
                        KDL.SchemaOne . KDL.NodeArg $
                          KDL.TypedValueSchema
                            { typeHint = typeRep $ Proxy @Int64
                            , validTypeAnns = []
                            , dataSchema =
                                KDL.SchemaOr
                                  [ KDL.SchemaOne KDL.NumberSchema
                                  , KDL.SchemaOne KDL.BoolSchema
                                  ]
                            }
                    }
              ]
      KDL.documentSchema decoder `shouldBe` expected