Add Default instance for format types, add test for default rendering

CHANGELOG.md

@@ -7,6 +7,7 @@
 
 API changes:
 * Rename `Text` constructor to `String` in `ValueData`
+* Overhauled `*Format` data types
 
 ## v0.2.1
 

kdl-hs.cabal

@@ -17,6 +17,7 @@ extra-source-files:
   CHANGELOG.md
   test/KDL/__snapshots__/DecoderSpec.snap.md
   test/KDL/__snapshots__/ParserSpec.snap.md
+  test/KDL/__snapshots__/RenderSpec.snap.md
 
 source-repository head
   type: git
@@ -42,6 +43,7 @@ library
   build-depends:
       base < 5
     , containers
+    , data-default
     , megaparsec
     , prettyprinter >= 1.7.0
     , scientific
@@ -77,6 +79,7 @@ test-suite kdl-tests
     KDL.Decoder.ArrowSpec
     KDL.Decoder.MonadSpec
     KDL.ParserSpec
+    KDL.RenderSpec
     KDL.TestUtils.AST
     KDL.TestUtils.Error
   build-depends:

src/KDL/Parser/Internal.hs

@@ -438,12 +438,13 @@ p_value = label "value" $ do
           Just a -> (Just $ appendTrailing postAnnWS a, "")
           Nothing -> (Nothing, postAnnWS)
 
-  (data_, repr) <-
+  (data_, repr_) <-
     withSource . choice . map try $
       [ String <$> p_string
       , p_number
       , p_keyword
       ]
+  let repr = Just repr_
 
   pure (Value{ann, data_, format = Just ValueFormat{..}}, leading)
 
@@ -473,7 +474,8 @@ p_type = label "type annotation" $ do
 -- | ref: (3.9)
 p_string'Identifier :: Parser Identifier
 p_string'Identifier = do
-  (value, repr) <- withSource p_string
+  (value, repr_) <- withSource p_string
+  let repr = Just repr_
   pure Identifier{value, format = Just IdentifierFormat{repr}}
 
 -- | ref: (3.9)

src/KDL/Render.hs

@@ -7,16 +7,13 @@ module KDL.Render (
   render,
 
   -- * Rendering components
-  renderNodeList,
-  renderNode,
-  renderEntry,
-  renderAnn,
   renderValue,
   renderValueData,
   renderIdentifier,
 ) where
 
 import Data.Char (isDigit)
+import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.Text qualified as Text
 import KDL.Types (
@@ -37,36 +34,49 @@ import KDL.Types (
  )
 
 render :: Document -> Text
-render = renderNodeList
+render = renderNodeList 0
 
-renderNodeList :: NodeList -> Text
-renderNodeList NodeList{..} =
+type IndentLevel = Int
+
+renderNodeList :: IndentLevel -> NodeList -> Text
+renderNodeList lvl NodeList{..} =
   Text.concat
-    [ maybe "" (.leading) format
-    , foldMap renderNode nodes
-    , maybe "" (.trailing) format
+    [ maybe (if lvl > 0 then "\n" else "") (.leading) format
+    , foldMap (renderNode lvl) nodes
+    , maybe (indent (lvl - 1)) (.trailing) format
     ]
 
-renderNode :: Node -> Text
-renderNode Node{..} =
+renderNode :: IndentLevel -> Node -> Text
+renderNode lvl Node{..} =
   Text.concat
-    [ maybe "" (.leading) format
+    [ maybe (indent lvl) (.leading) format
     , maybe "" renderAnn ann
     , renderIdentifier name
     , foldMap renderEntry entries
-    , maybe "" (.beforeChildren) format
+    , let def_ = if children == Nothing then "" else " "
+       in maybe def_ (.beforeChildren) format
     , case children of
         Nothing -> ""
-        Just nodes -> "{" <> renderNodeList nodes <> "}"
+        Just nodes -> renderChildren lvl nodes
     , maybe "" (.beforeTerminator) format
-    , maybe "" (.terminator) format
+    , maybe "\n" (.terminator) format
     , maybe "" (.trailing) format
     ]
 
+renderChildren :: IndentLevel -> NodeList -> Text
+renderChildren lvl nodeList =
+  case nodeList.format of
+    -- Special case empty node list to render as "{}"
+    Nothing | null nodeList.nodes -> "{}"
+    _ -> "{" <> renderNodeList (lvl + 1) nodeList <> "}"
+
+indent :: IndentLevel -> Text
+indent lvl = Text.replicate lvl "  "
+
 renderEntry :: Entry -> Text
 renderEntry Entry{..} =
   Text.concat
-    [ maybe "" (.leading) format
+    [ maybe " " (.leading) format
     , case name of
         Nothing -> renderValue value
         Just nameId ->
@@ -96,7 +106,7 @@ renderValue :: Value -> Text
 renderValue Value{..} =
   Text.concat
     [ maybe "" renderAnn ann
-    , maybe (renderValueData data_) (.repr) format
+    , fromMaybe (renderValueData data_) (format >>= (.repr))
     ]
 
 renderValueData :: ValueData -> Text
@@ -181,4 +191,4 @@ renderValueData = \case
     c -> Text.singleton c
 
 renderIdentifier :: Identifier -> Text
-renderIdentifier ident = maybe ident.value (.repr) ident.format
+renderIdentifier ident = fromMaybe ident.value (ident.format >>= (.repr))

src/KDL/Types.hs

@@ -73,9 +73,13 @@ module KDL.Types (
   fromIdentifier,
   identifierFormat,
   toIdentifier,
+
+  -- * Re-exports
+  def,
 ) where
 
 import Control.Monad ((<=<))
+import Data.Default (Default (..))
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Maybe (listToMaybe, mapMaybe)
@@ -105,6 +109,13 @@ data NodeListFormat = NodeListFormat
   }
   deriving (Show, Eq)
 
+instance Default NodeListFormat where
+  def =
+    NodeListFormat
+      { leading = ""
+      , trailing = ""
+      }
+
 fromNodeList :: NodeList -> [Node]
 fromNodeList = (.nodes)
 
@@ -213,6 +224,15 @@ data AnnFormat = AnnFormat
   }
   deriving (Show, Eq)
 
+instance Default AnnFormat where
+  def =
+    AnnFormat
+      { leading = ""
+      , beforeId = ""
+      , afterId = ""
+      , trailing = ""
+      }
+
 annIdentifier :: Ann -> Identifier
 annIdentifier = (.identifier)
 
@@ -244,6 +264,16 @@ data NodeFormat = NodeFormat
   }
   deriving (Show, Eq)
 
+instance Default NodeFormat where
+  def =
+    NodeFormat
+      { leading = ""
+      , beforeChildren = ""
+      , beforeTerminator = ""
+      , terminator = ""
+      , trailing = ""
+      }
+
 nodeAnn :: Node -> Maybe Ann
 nodeAnn = (.ann)
 
@@ -304,6 +334,15 @@ data EntryFormat = EntryFormat
   }
   deriving (Show, Eq)
 
+instance Default EntryFormat where
+  def =
+    EntryFormat
+      { leading = ""
+      , afterKey = ""
+      , afterEq = ""
+      , trailing = ""
+      }
+
 entryName :: Entry -> Maybe Identifier
 entryName = (.name)
 
@@ -323,11 +362,17 @@ data Value = Value
   deriving (Show, Eq)
 
 data ValueFormat = ValueFormat
-  { repr :: Text
+  { repr :: Maybe Text
   -- ^ The actual text representation of the value.
   }
   deriving (Show, Eq)
 
+instance Default ValueFormat where
+  def =
+    ValueFormat
+      { repr = Nothing
+      }
+
 valueAnn :: Value -> Maybe Ann
 valueAnn = (.ann)
 
@@ -356,10 +401,16 @@ data Identifier = Identifier
   deriving (Show, Eq, Ord)
 
 data IdentifierFormat = IdentifierFormat
-  { repr :: Text
+  { repr :: Maybe Text
   }
   deriving (Show, Eq, Ord)
 
+instance Default IdentifierFormat where
+  def =
+    IdentifierFormat
+      { repr = Nothing
+      }
+
 fromIdentifier :: Identifier -> Text
 fromIdentifier = (.value)
 

test/KDL/RenderSpec.hs

@@ -0,0 +1,117 @@
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module KDL.RenderSpec (spec) where
+
+import KDL qualified
+import Skeletest
+import Skeletest.Predicate qualified as P
+
+spec :: Spec
+spec = do
+  describe "render" $ do
+    describe "default formatting" $ do
+      let ident s = KDL.Identifier{value = s, format = KDL.def}
+          fooAnn =
+            KDL.Ann
+              { identifier = ident "Foo"
+              , format = KDL.def
+              }
+          doc =
+            KDL.NodeList
+              { nodes =
+                  [ KDL.Node
+                      { ann = Just fooAnn
+                      , name = ident "foo"
+                      , entries =
+                          [ KDL.Entry
+                              { name = Nothing
+                              , value =
+                                  KDL.Value
+                                    { ann = Just fooAnn
+                                    , data_ = KDL.Number 123
+                                    , format = KDL.def
+                                    }
+                              , format = KDL.def
+                              }
+                          , KDL.Entry
+                              { name = Just $ ident "a"
+                              , value =
+                                  KDL.Value
+                                    { ann = Just fooAnn
+                                    , data_ = KDL.Number 123
+                                    , format = KDL.def
+                                    }
+                              , format = KDL.def
+                              }
+                          , KDL.Entry
+                              { name = Nothing
+                              , value =
+                                  KDL.Value
+                                    { ann = Nothing
+                                    , data_ = KDL.String "test"
+                                    , format = KDL.def
+                                    }
+                              , format = KDL.def
+                              }
+                          , KDL.Entry
+                              { name = Just $ ident "b"
+                              , value =
+                                  KDL.Value
+                                    { ann = Nothing
+                                    , data_ = KDL.String "test"
+                                    , format = KDL.def
+                                    }
+                              , format = KDL.def
+                              }
+                          ]
+                      , children =
+                          Just
+                            KDL.NodeList
+                              { nodes =
+                                  [ KDL.Node
+                                      { ann = Nothing
+                                      , name = ident "bar"
+                                      , entries = []
+                                      , children =
+                                          Just
+                                            KDL.NodeList
+                                              { nodes =
+                                                  [ KDL.Node
+                                                      { ann = Nothing
+                                                      , name = ident "baz"
+                                                      , entries = []
+                                                      , children = Nothing
+                                                      , format = KDL.def
+                                                      }
+                                                  ]
+                                              , format = KDL.def
+                                              }
+                                      , format = KDL.def
+                                      }
+                                  ]
+                              , format = KDL.def
+                              }
+                      , format = KDL.def
+                      }
+                  , KDL.Node
+                      { ann = Just fooAnn
+                      , name = ident "foo"
+                      , entries = []
+                      , children =
+                          Just
+                            KDL.NodeList
+                              { nodes = []
+                              , format = KDL.def
+                              }
+                      , format = KDL.def
+                      }
+                  ]
+              , format = KDL.def
+              }
+
+      it "renders correctly" $ do
+        KDL.render doc `shouldSatisfy` P.matchesSnapshot
+
+      it "can be parsed" $ do
+        (KDL.parse . KDL.render) doc `shouldSatisfy` P.right P.anything