Skip to content

Commit 61e113c

Browse files
Use same Decoder type across Monad/Arrow
1 parent 83d3d8b commit 61e113c

8 files changed

Lines changed: 113 additions & 754 deletions

File tree

kdl-hs.cabal

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,11 +24,12 @@ library
2424
hs-source-dirs: src
2525
exposed-modules:
2626
Data.KDL
27+
Data.KDL.Arrow
2728
Data.KDL.Decoder
2829
Data.KDL.Decoder.Arrow
29-
Data.KDL.Decoder.Arrow.Internal
3030
Data.KDL.Decoder.Internal.DecodeM
3131
Data.KDL.Decoder.Internal.Error
32+
Data.KDL.Decoder.Internal.Monad
3233
Data.KDL.Decoder.Monad
3334
Data.KDL.Decoder.Schema
3435
Data.KDL.Parser

src/Data/KDL.hs

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,10 @@ This module is intended to be imported qualified as:
33
44
> import Data.KDL qualified as KDL
55
6+
This provides a Monad interface for decoding KDL files, which is sufficient for
7+
most cases. You may wish to use "Data.KDL.Arrow" if you would like to
8+
statically analyze a decoder's schema, e.g. to generate documentation.
9+
610
= Quickstart
711
812
Given a file @config.kdl@:
@@ -47,14 +51,14 @@ data Dep = Dep
4751
deriving (Show)
4852
4953
instance KDL.DecodeNode Config where
50-
nodeDecoder = KDL.noSchema $ do
54+
nodeDecoder = do
5155
name <- KDL.argAt "name"
5256
version <- KDL.argAt "version"
5357
dependencies <- KDL.nodeWith "dependencies" . KDL.children $ KDL.remainingNodes
5458
pure Config{..}
5559
5660
instance KDL.DecodeNode Dep where
57-
nodeDecoder = KDL.noSchema $ do
61+
nodeDecoder = do
5862
version <- KDL.arg
5963
optional <- KDL.option False $ KDL.prop "optional"
6064
pure Dep{..}

src/Data/KDL/Arrow.hs

Lines changed: 78 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,78 @@
1+
{-|
2+
This module defines the Arrow interface for decoding a KDL document. Intended to
3+
be imported qualified as:
4+
5+
> import Data.KDL.Arrow qualified as KDL
6+
7+
For most use-cases, the Monad interface exported by "Data.KDL" is sufficient. You
8+
may wish to use the Arrow interface if you would like to statically analyze a
9+
decoder's schema, e.g. to generate documentation.
10+
11+
= Quickstart
12+
13+
Given a file @config.kdl@:
14+
15+
@
16+
package {
17+
name my-pkg
18+
version "1.2.3"
19+
20+
dependencies {
21+
aeson ">= 2.2.3.0" optional=#true
22+
text ">= 2"
23+
}
24+
}
25+
@
26+
27+
Parse it with:
28+
29+
@
30+
{\-# LANGUAGE Arrows #-\}
31+
32+
import Data.KDL.Decoder.Arrow qualified as KDL
33+
34+
main :: IO ()
35+
main = do
36+
config <- KDL.decodeFileWith decoder "config.kdl"
37+
print config
38+
39+
decoder :: KDL.Decoder Config
40+
decoder = KDL.document $ proc () -> do
41+
KDL.node "package" -< ()
42+
43+
data Config = Config
44+
{ name :: Text
45+
, version :: Text
46+
, dependencies :: Map Text Dep
47+
}
48+
deriving (Show)
49+
50+
data Dep = Dep
51+
{ version :: Text
52+
, optional :: Bool
53+
}
54+
deriving (Show)
55+
56+
instance KDL.DecodeNode Config where
57+
nodeDecoder = proc () -> do
58+
name <- KDL.argAt "name" -< ()
59+
version <- KDL.argAt "version" -< ()
60+
dependencies <- KDL.nodeWith "dependencies" . KDL.children $ KDL.remainingNodes -< ()
61+
returnA -< Config{..}
62+
63+
instance KDL.DecodeNode Dep where
64+
nodeDecoder = proc () -> do
65+
version <- KDL.arg -< ()
66+
optional <- KDL.option False $ KDL.prop "optional" -< ()
67+
returnA -< Dep{..}
68+
@
69+
-}
70+
module Data.KDL.Arrow (
71+
module X,
72+
) where
73+
74+
import Data.KDL.Decoder.Arrow as X
75+
import Data.KDL.Decoder.Schema as X
76+
import Data.KDL.Parser as X
77+
import Data.KDL.Render as X
78+
import Data.KDL.Types as X

src/Data/KDL/Decoder/Arrow.hs

Lines changed: 1 addition & 70 deletions
Original file line numberDiff line numberDiff line change
@@ -5,75 +5,6 @@
55
{-# LANGUAGE OverloadedStrings #-}
66
{-# LANGUAGE TypeFamilies #-}
77

8-
{-|
9-
This module defines the Arrow interface for decoding a KDL document. Intended to
10-
be imported qualified as:
11-
12-
> import Data.KDL.Decoder.Arrow qualified as KDL
13-
14-
For most use-cases, the Monad interface exported by "Data.KDL" is sufficient. You
15-
may wish to use the Arrow interface if you would like to statically analyze a
16-
decoder's schema, e.g. to generate documentation.
17-
18-
= Quickstart
19-
20-
Given a file @config.kdl@:
21-
22-
@
23-
package {
24-
name my-pkg
25-
version "1.2.3"
26-
27-
dependencies {
28-
aeson ">= 2.2.3.0" optional=#true
29-
text ">= 2"
30-
}
31-
}
32-
@
33-
34-
Parse it with:
35-
36-
@
37-
{\-# LANGUAGE Arrows #-\}
38-
39-
import Data.KDL.Decoder.Arrow qualified as KDL
40-
41-
main :: IO ()
42-
main = do
43-
config <- KDL.decodeFileWith decoder "config.kdl"
44-
print config
45-
46-
decoder :: KDL.Decoder Config
47-
decoder = KDL.document $ proc () -> do
48-
KDL.node "package" -< ()
49-
50-
data Config = Config
51-
{ name :: Text
52-
, version :: Text
53-
, dependencies :: Map Text Dep
54-
}
55-
deriving (Show)
56-
57-
data Dep = Dep
58-
{ version :: Text
59-
, optional :: Bool
60-
}
61-
deriving (Show)
62-
63-
instance KDL.DecodeNode Config where
64-
nodeDecoder = proc () -> do
65-
name <- KDL.argAt "name" -< ()
66-
version <- KDL.argAt "version" -< ()
67-
dependencies <- KDL.nodeWith "dependencies" . KDL.children $ KDL.remainingNodes -< ()
68-
returnA -< Config{..}
69-
70-
instance KDL.DecodeNode Dep where
71-
nodeDecoder = proc () -> do
72-
version <- KDL.arg -< ()
73-
optional <- KDL.option False $ KDL.prop "optional" -< ()
74-
returnA -< Dep{..}
75-
@
76-
-}
778
module Data.KDL.Decoder.Arrow (
789
decodeWith,
7910
decodeFileWith,
@@ -160,8 +91,8 @@ import Control.Monad.Trans.State.Strict (StateT)
16091
import Control.Monad.Trans.State.Strict qualified as StateT
16192
import Data.Bits (finiteBitSize)
16293
import Data.Int (Int64)
163-
import Data.KDL.Decoder.Arrow.Internal
16494
import Data.KDL.Decoder.Internal.DecodeM
95+
import Data.KDL.Decoder.Internal.Monad
16596
import Data.KDL.Decoder.Schema (
16697
Schema (..),
16798
SchemaItem (..),
Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
{-# LANGUAGE OverloadedRecordDot #-}
22
{-# LANGUAGE TypeFamilies #-}
33

4-
module Data.KDL.Decoder.Arrow.Internal (
4+
module Data.KDL.Decoder.Internal.Monad (
55
-- * Decoder
66
Decoder (..),
77
liftDecodeM,
@@ -94,7 +94,8 @@ runDecodeStateM o hist m =
9494

9595
-- | @Decoder o a b@ represents an arrow with input @a@ and output @b@, within
9696
-- the context of decoding a KDL object of type @o@. It also knows the expected
97-
-- schema of @o@.
97+
-- schema of @o@. Most of the time, @a@ is @()@; it would only be different if
98+
-- you're using Arrows notation.
9899
--
99100
-- We're using arrows here so that we can:
100101
--
@@ -140,6 +141,14 @@ instance Alternative (Decoder o a) where
140141
in go
141142
many (Decoder sch run) = some (Decoder sch run) <|> pure []
142143

144+
-- | Eliminates all schema information; avoid whenever possible.
145+
instance Monad (Decoder o a) where
146+
Decoder _ run1 >>= k =
147+
Decoder SchemaUnknown $ \a -> do
148+
x <- run1 a
149+
let Decoder _ run2 = k x
150+
run2 a
151+
143152
liftDecodeM :: (a -> DecodeM b) -> Decoder o a b
144153
liftDecodeM f = Decoder (SchemaAnd []) (Trans.lift . f)
145154

0 commit comments

Comments
 (0)