feat: refactoring around unnamed fields
This commit is contained in:
parent
7d2259f197
commit
cb99daeb49
1 changed files with 6 additions and 9 deletions
|
@ -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)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue