fix[KeyValueMapping]: emit constructor body, commas ... etc

src/Pretty/Serialize.hs

@@ -14,7 +14,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE TypeFamilies #-}
-module Pretty.Serialize (Serializer, PrettySerialize(..), ShowPrettySerialize(..), run, emit, KeyValueSerialize(..)) where
+module Pretty.Serialize (Serializer, PrettySerialize(..), ShowPrettySerialize(..), run, emit, KeyValueSerialize(..), customField) where
 
 import Data.Text.Lazy.Builder (Builder)
 import Data.Text.Lazy (Text)
@@ -41,6 +41,7 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.ByteString.Lazy (LazyByteString)
 import Data.ByteString (ByteString)
+import Data.Maybe (fromMaybe)
 
 type Indentation = Word
 
@@ -119,12 +120,13 @@ unnamedField = recordField serializer
 namedField :: Text -> Serializer a -> Serializer a
 namedField name = recordField (const $ emit name)
 
-inConstructor :: Text -> Serializer a -> Serializer a
+customField :: Serializer () -> Serializer a -> Serializer a
-inConstructor name body = do
+customField = recordField . const
-  oldIndentation <- indentation <$!> getSerializerState
-  emit "::"
-  emit name
 
+beginFields :: Maybe (Serializer ()) -> Serializer b -> Serializer b
+beginFields name body = do
+  oldIndentation <- indentation <$!> getSerializerState
+  fromMaybe (pure ()) name
   -- increase the indentation
   modifySerializerState $ \ state -> state { currentFieldIndex = Nothing, indentation = state.increaseIndentation state.indentation  }
 
@@ -142,6 +144,10 @@ inConstructor name body = do
 
   pure result
 
+inNamedConstructor :: Text -> Serializer a -> Serializer a
+inNamedConstructor name = beginFields $ Just (emit "::" >> emit name)
+
+
 inDatatype :: Text -> Serializer b -> Serializer b
 inDatatype name body = do
   emit name
@@ -235,11 +241,10 @@ newtype KeyValueSerialize a = KeyValueSerialize a
 instance (ExtractMappings a, Typeable a, PrettySerialize (KeyType a), PrettySerialize (ValueType a)) => PrettySerialize (KeyValueSerialize a) where
   serializer :: KeyValueSerialize a -> Serializer ()
   serializer (KeyValueSerialize mapping) = do
-    inDatatypeOf mapping $ do
+    inDatatypeOf mapping $ do -- set type name
-      forM_ (keyValuePairs mapping) $ \ (key, value) -> do
+      beginFields Nothing $ do -- don't set constructor name
-        serializer key
+        forM_ (keyValuePairs mapping) $ \ (key, value) -> do -- emit fields
-        emit " = "
+          customField (serializer key) (serializer value)
-        serializer value
 
 deriving via KeyValueSerialize (Data.IArray.Array index element) instance (Data.IArray.Ix index, Typeable index, Typeable element, PrettySerialize index, PrettySerialize element) => PrettySerialize (Data.IArray.Array index element)
 deriving via KeyValueSerialize (List a) instance (Typeable a, PrettySerialize a) => PrettySerialize (List a)
@@ -277,7 +282,7 @@ instance (KnownSymbol name, GenericPrettySerialize a) => GenericPrettySerialize
 -- constructor metadata
 instance (GenericPrettySerialize a, KnownSymbol name) => GenericPrettySerialize (M1 tag (MetaCons name fixity isRecord) a) where
   genericDumpSerializer :: M1 tag (MetaCons name fixity isRecord) a x -> Serializer ()
-  genericDumpSerializer (M1 c) = inConstructor (fromString contructorName) (genericDumpSerializer c)
+  genericDumpSerializer (M1 c) = inNamedConstructor (fromString contructorName) (genericDumpSerializer c)
     where
       contructorName = symbolVal (Proxy @name)