feat: refactoring around unnamed fields

This commit is contained in:
vegowotenks 2025-08-23 19:12:08 +02:00
parent 7d2259f197
commit cb99daeb49

View file

@ -15,7 +15,7 @@
{-# LANGUAGE DerivingVia #-} {-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
module Pretty.Serialize (Serializer, PrettySerialize(..), ShowPrettySerialize(..), run, emit, KeyValueSerialize(..), customField) where module Pretty.Serialize (Serializer, PrettySerialize(..), ShowPrettySerialize(..), run, emit, KeyValueSerialize(..), recordField) where
import Data.Text.Lazy (LazyText) import Data.Text.Lazy (LazyText)
import GHC.Generics (U1, K1 (K1), Generically (Generically), Generic (Rep), from, M1 (M1), Meta(MetaSel, MetaCons, MetaData), (:+:) (L1, R1), (:*:) ((:*:))) import GHC.Generics (U1, K1 (K1), Generically (Generically), Generic (Rep), from, M1 (M1), Meta(MetaSel, MetaCons, MetaData), (:+:) (L1, R1), (:*:) ((:*:)))
@ -98,7 +98,7 @@ lineBreak = do
emit "\n" emit "\n"
emit $ StrictText.replicate (fromIntegral spaces) " " emit $ StrictText.replicate (fromIntegral spaces) " "
recordField :: (Word -> Serializer ()) -> Serializer b -> Serializer b recordField :: Serializer () -> Serializer b -> Serializer b
recordField labelField dumpField = do recordField labelField dumpField = do
maybeFieldIndex <- currentFieldIndex <$!> getSerializerState maybeFieldIndex <- currentFieldIndex <$!> getSerializerState
@ -111,7 +111,7 @@ recordField labelField dumpField = do
lineBreak lineBreak
-- what is the field called? -- what is the field called?
labelField n labelField
emit ": " emit ": "
result <- dumpField result <- dumpField
@ -122,13 +122,10 @@ recordField labelField dumpField = do
pure result pure result
unnamedField :: Serializer a -> Serializer a unnamedField :: Serializer a -> Serializer a
unnamedField = recordField serializer unnamedField = recordField $ pure ()
namedField :: StrictText -> Serializer a -> Serializer a namedField :: StrictText -> Serializer a -> Serializer a
namedField name = recordField (const $ emit name) namedField name = recordField $ emit name
customField :: Serializer () -> Serializer a -> Serializer a
customField = recordField . const
beginFields :: Maybe (Serializer ()) -> Serializer b -> Serializer b beginFields :: Maybe (Serializer ()) -> Serializer b -> Serializer b
beginFields name body = do beginFields name body = do
@ -265,7 +262,7 @@ instance (ExtractMappings a, Typeable a, PrettySerialize (KeyType a), PrettySeri
inDatatypeOf mapping $ do -- set type name inDatatypeOf mapping $ do -- set type name
beginFields Nothing $ do -- don't set constructor name beginFields Nothing $ do -- don't set constructor name
forM_ (keyValuePairs mapping) $ \ (key, value) -> do -- emit fields forM_ (keyValuePairs mapping) $ \ (key, value) -> do -- emit fields
customField (serializer key) (serializer value) recordField (serializer key) (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 (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) deriving via KeyValueSerialize (List a) instance (Typeable a, PrettySerialize a) => PrettySerialize (List a)