Skip to content

Commit 3a36e38

Browse files
brandonchinn178brandonchinn178
authored
Add Default instance for format types, add test for default rendering (#19)
* Add Default instances for all format types * Add render tests * Fix default rendering
1 parent 88dc8da commit 3a36e38

8 files changed

Lines changed: 228 additions & 28 deletions

File tree

‎CHANGELOG.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77

88
API changes:
99
* Rename `Text` constructor to `String` in `ValueData`
10+
* Overhauled `*Format` data types
1011

1112
## v0.2.1
1213

‎kdl-hs.cabal‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ extra-source-files:
1717
CHANGELOG.md
1818
test/KDL/__snapshots__/DecoderSpec.snap.md
1919
test/KDL/__snapshots__/ParserSpec.snap.md
20+
test/KDL/__snapshots__/RenderSpec.snap.md
2021

2122
source-repository head
2223
type: git
@@ -42,6 +43,7 @@ library
4243
build-depends:
4344
base < 5
4445
, containers
46+
, data-default
4547
, megaparsec
4648
, prettyprinter >= 1.7.0
4749
, scientific
@@ -77,6 +79,7 @@ test-suite kdl-tests
7779
KDL.Decoder.ArrowSpec
7880
KDL.Decoder.MonadSpec
7981
KDL.ParserSpec
82+
KDL.RenderSpec
8083
KDL.TestUtils.AST
8184
KDL.TestUtils.Error
8285
build-depends:

‎src/KDL/Parser/Internal.hs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -438,12 +438,13 @@ p_value = label "value" $ do
438438
Just a -> (Just $ appendTrailing postAnnWS a, "")
439439
Nothing -> (Nothing, postAnnWS)
440440

441-
(data_, repr) <-
441+
(data_, repr_) <-
442442
withSource . choice . map try $
443443
[ String <$> p_string
444444
, p_number
445445
, p_keyword
446446
]
447+
let repr = Just repr_
447448

448449
pure (Value{ann, data_, format = Just ValueFormat{..}}, leading)
449450

@@ -473,7 +474,8 @@ p_type = label "type annotation" $ do
473474
-- | ref: (3.9)
474475
p_string'Identifier :: Parser Identifier
475476
p_string'Identifier = do
476-
(value, repr) <- withSource p_string
477+
(value, repr_) <- withSource p_string
478+
let repr = Just repr_
477479
pure Identifier{value, format = Just IdentifierFormat{repr}}
478480

479481
-- | ref: (3.9)

‎src/KDL/Render.hs‎

Lines changed: 29 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -7,16 +7,13 @@ module KDL.Render (
77
render,
88

99
-- * Rendering components
10-
renderNodeList,
11-
renderNode,
12-
renderEntry,
13-
renderAnn,
1410
renderValue,
1511
renderValueData,
1612
renderIdentifier,
1713
) where
1814

1915
import Data.Char (isDigit)
16+
import Data.Maybe (fromMaybe)
2017
import Data.Text (Text)
2118
import Data.Text qualified as Text
2219
import KDL.Types (
@@ -37,36 +34,49 @@ import KDL.Types (
3734
)
3835

3936
render :: Document -> Text
40-
render = renderNodeList
37+
render = renderNodeList 0
4138

42-
renderNodeList :: NodeList -> Text
43-
renderNodeList NodeList{..} =
39+
type IndentLevel = Int
40+
41+
renderNodeList :: IndentLevel -> NodeList -> Text
42+
renderNodeList lvl NodeList{..} =
4443
Text.concat
45-
[ maybe "" (.leading) format
46-
, foldMap renderNode nodes
47-
, maybe "" (.trailing) format
44+
[ maybe (if lvl > 0 then "\n" else "") (.leading) format
45+
, foldMap (renderNode lvl) nodes
46+
, maybe (indent (lvl - 1)) (.trailing) format
4847
]
4948

50-
renderNode :: Node -> Text
51-
renderNode Node{..} =
49+
renderNode :: IndentLevel -> Node -> Text
50+
renderNode lvl Node{..} =
5251
Text.concat
53-
[ maybe "" (.leading) format
52+
[ maybe (indent lvl) (.leading) format
5453
, maybe "" renderAnn ann
5554
, renderIdentifier name
5655
, foldMap renderEntry entries
57-
, maybe "" (.beforeChildren) format
56+
, let def_ = if children == Nothing then "" else " "
57+
in maybe def_ (.beforeChildren) format
5858
, case children of
5959
Nothing -> ""
60-
Just nodes -> "{" <> renderNodeList nodes <> "}"
60+
Just nodes -> renderChildren lvl nodes
6161
, maybe "" (.beforeTerminator) format
62-
, maybe "" (.terminator) format
62+
, maybe "\n" (.terminator) format
6363
, maybe "" (.trailing) format
6464
]
6565

66+
renderChildren :: IndentLevel -> NodeList -> Text
67+
renderChildren lvl nodeList =
68+
case nodeList.format of
69+
-- Special case empty node list to render as "{}"
70+
Nothing | null nodeList.nodes -> "{}"
71+
_ -> "{" <> renderNodeList (lvl + 1) nodeList <> "}"
72+
73+
indent :: IndentLevel -> Text
74+
indent lvl = Text.replicate lvl " "
75+
6676
renderEntry :: Entry -> Text
6777
renderEntry Entry{..} =
6878
Text.concat
69-
[ maybe "" (.leading) format
79+
[ maybe " " (.leading) format
7080
, case name of
7181
Nothing -> renderValue value
7282
Just nameId ->
@@ -96,7 +106,7 @@ renderValue :: Value -> Text
96106
renderValue Value{..} =
97107
Text.concat
98108
[ maybe "" renderAnn ann
99-
, maybe (renderValueData data_) (.repr) format
109+
, fromMaybe (renderValueData data_) (format >>= (.repr))
100110
]
101111

102112
renderValueData :: ValueData -> Text
@@ -181,4 +191,4 @@ renderValueData = \case
181191
c -> Text.singleton c
182192

183193
renderIdentifier :: Identifier -> Text
184-
renderIdentifier ident = maybe ident.value (.repr) ident.format
194+
renderIdentifier ident = fromMaybe ident.value (ident.format >>= (.repr))

‎src/KDL/Types.hs‎

Lines changed: 53 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -73,9 +73,13 @@ module KDL.Types (
7373
fromIdentifier,
7474
identifierFormat,
7575
toIdentifier,
76+
77+
-- * Re-exports
78+
def,
7679
) where
7780

7881
import Control.Monad ((<=<))
82+
import Data.Default (Default (..))
7983
import Data.Map (Map)
8084
import Data.Map qualified as Map
8185
import Data.Maybe (listToMaybe, mapMaybe)
@@ -105,6 +109,13 @@ data NodeListFormat = NodeListFormat
105109
}
106110
deriving (Show, Eq)
107111

112+
instance Default NodeListFormat where
113+
def =
114+
NodeListFormat
115+
{ leading = ""
116+
, trailing = ""
117+
}
118+
108119
fromNodeList :: NodeList -> [Node]
109120
fromNodeList = (.nodes)
110121

@@ -213,6 +224,15 @@ data AnnFormat = AnnFormat
213224
}
214225
deriving (Show, Eq)
215226

227+
instance Default AnnFormat where
228+
def =
229+
AnnFormat
230+
{ leading = ""
231+
, beforeId = ""
232+
, afterId = ""
233+
, trailing = ""
234+
}
235+
216236
annIdentifier :: Ann -> Identifier
217237
annIdentifier = (.identifier)
218238

@@ -244,6 +264,16 @@ data NodeFormat = NodeFormat
244264
}
245265
deriving (Show, Eq)
246266

267+
instance Default NodeFormat where
268+
def =
269+
NodeFormat
270+
{ leading = ""
271+
, beforeChildren = ""
272+
, beforeTerminator = ""
273+
, terminator = ""
274+
, trailing = ""
275+
}
276+
247277
nodeAnn :: Node -> Maybe Ann
248278
nodeAnn = (.ann)
249279

@@ -304,6 +334,15 @@ data EntryFormat = EntryFormat
304334
}
305335
deriving (Show, Eq)
306336

337+
instance Default EntryFormat where
338+
def =
339+
EntryFormat
340+
{ leading = ""
341+
, afterKey = ""
342+
, afterEq = ""
343+
, trailing = ""
344+
}
345+
307346
entryName :: Entry -> Maybe Identifier
308347
entryName = (.name)
309348

@@ -323,11 +362,17 @@ data Value = Value
323362
deriving (Show, Eq)
324363

325364
data ValueFormat = ValueFormat
326-
{ repr :: Text
365+
{ repr :: Maybe Text
327366
-- ^ The actual text representation of the value.
328367
}
329368
deriving (Show, Eq)
330369

370+
instance Default ValueFormat where
371+
def =
372+
ValueFormat
373+
{ repr = Nothing
374+
}
375+
331376
valueAnn :: Value -> Maybe Ann
332377
valueAnn = (.ann)
333378

@@ -356,10 +401,16 @@ data Identifier = Identifier
356401
deriving (Show, Eq, Ord)
357402

358403
data IdentifierFormat = IdentifierFormat
359-
{ repr :: Text
404+
{ repr :: Maybe Text
360405
}
361406
deriving (Show, Eq, Ord)
362407

408+
instance Default IdentifierFormat where
409+
def =
410+
IdentifierFormat
411+
{ repr = Nothing
412+
}
413+
363414
fromIdentifier :: Identifier -> Text
364415
fromIdentifier = (.value)
365416

‎test/KDL/RenderSpec.hs‎

Lines changed: 117 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,117 @@
1+
{-# LANGUAGE DisambiguateRecordFields #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
4+
module KDL.RenderSpec (spec) where
5+
6+
import KDL qualified
7+
import Skeletest
8+
import Skeletest.Predicate qualified as P
9+
10+
spec :: Spec
11+
spec = do
12+
describe "render" $ do
13+
describe "default formatting" $ do
14+
let ident s = KDL.Identifier{value = s, format = KDL.def}
15+
fooAnn =
16+
KDL.Ann
17+
{ identifier = ident "Foo"
18+
, format = KDL.def
19+
}
20+
doc =
21+
KDL.NodeList
22+
{ nodes =
23+
[ KDL.Node
24+
{ ann = Just fooAnn
25+
, name = ident "foo"
26+
, entries =
27+
[ KDL.Entry
28+
{ name = Nothing
29+
, value =
30+
KDL.Value
31+
{ ann = Just fooAnn
32+
, data_ = KDL.Number 123
33+
, format = KDL.def
34+
}
35+
, format = KDL.def
36+
}
37+
, KDL.Entry
38+
{ name = Just $ ident "a"
39+
, value =
40+
KDL.Value
41+
{ ann = Just fooAnn
42+
, data_ = KDL.Number 123
43+
, format = KDL.def
44+
}
45+
, format = KDL.def
46+
}
47+
, KDL.Entry
48+
{ name = Nothing
49+
, value =
50+
KDL.Value
51+
{ ann = Nothing
52+
, data_ = KDL.String "test"
53+
, format = KDL.def
54+
}
55+
, format = KDL.def
56+
}
57+
, KDL.Entry
58+
{ name = Just $ ident "b"
59+
, value =
60+
KDL.Value
61+
{ ann = Nothing
62+
, data_ = KDL.String "test"
63+
, format = KDL.def
64+
}
65+
, format = KDL.def
66+
}
67+
]
68+
, children =
69+
Just
70+
KDL.NodeList
71+
{ nodes =
72+
[ KDL.Node
73+
{ ann = Nothing
74+
, name = ident "bar"
75+
, entries = []
76+
, children =
77+
Just
78+
KDL.NodeList
79+
{ nodes =
80+
[ KDL.Node
81+
{ ann = Nothing
82+
, name = ident "baz"
83+
, entries = []
84+
, children = Nothing
85+
, format = KDL.def
86+
}
87+
]
88+
, format = KDL.def
89+
}
90+
, format = KDL.def
91+
}
92+
]
93+
, format = KDL.def
94+
}
95+
, format = KDL.def
96+
}
97+
, KDL.Node
98+
{ ann = Just fooAnn
99+
, name = ident "foo"
100+
, entries = []
101+
, children =
102+
Just
103+
KDL.NodeList
104+
{ nodes = []
105+
, format = KDL.def
106+
}
107+
, format = KDL.def
108+
}
109+
]
110+
, format = KDL.def
111+
}
112+
113+
it "renders correctly" $ do
114+
KDL.render doc `shouldSatisfy` P.matchesSnapshot
115+
116+
it "can be parsed" $ do
117+
(KDL.parse . KDL.render) doc `shouldSatisfy` P.right P.anything

0 commit comments

Comments
 (0)
⚡