refactored everything
This commit is contained in:
parent
883569139d
commit
126a2982b8
3 changed files with 44 additions and 50 deletions
|
|
@ -1,4 +1,4 @@
|
|||
cabal-version: 2.2
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.38.1.
|
||||
--
|
||||
|
|
@ -12,7 +12,7 @@ bug-reports: https://github.com/githubuser/pretty-parse/issues
|
|||
author: Author name here
|
||||
maintainer: example@example.com
|
||||
copyright: 2025 Author name here
|
||||
license: BSD-3-Clause
|
||||
license: AGPL-3.0
|
||||
license-file: LICENSE
|
||||
build-type: Simple
|
||||
extra-source-files:
|
||||
|
|
@ -25,12 +25,10 @@ source-repository head
|
|||
|
||||
library
|
||||
exposed-modules:
|
||||
Text.Dump.Example
|
||||
Text.Dump.Serialize
|
||||
Pretty.Example
|
||||
Pretty.Serialize
|
||||
other-modules:
|
||||
Paths_pretty_parse
|
||||
autogen-modules:
|
||||
Paths_pretty_parse
|
||||
hs-source-dirs:
|
||||
src
|
||||
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
|
||||
|
|
@ -43,8 +41,6 @@ executable pretty-parse-exe
|
|||
main-is: Main.hs
|
||||
other-modules:
|
||||
Paths_pretty_parse
|
||||
autogen-modules:
|
||||
Paths_pretty_parse
|
||||
hs-source-dirs:
|
||||
app
|
||||
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
|
||||
|
|
@ -59,8 +55,6 @@ test-suite pretty-parse-test
|
|||
main-is: Spec.hs
|
||||
other-modules:
|
||||
Paths_pretty_parse
|
||||
autogen-modules:
|
||||
Paths_pretty_parse
|
||||
hs-source-dirs:
|
||||
test
|
||||
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
|
||||
|
|
|
|||
|
|
@ -1,16 +1,16 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
module Text.Dump.Example () where
|
||||
module Pretty.Example () where
|
||||
import GHC.Generics
|
||||
( Generic, Generically, Generically(Generically) )
|
||||
import Text.Dump.Serialize (TextDump(..))
|
||||
import Pretty.Serialize (PrettySerialize)
|
||||
|
||||
data RecordType = RecordType
|
||||
{ field1 :: Int
|
||||
, field2 :: Maybe Bool
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
deriving TextDump via (Generically RecordType)
|
||||
deriving PrettySerialize via (Generically RecordType)
|
||||
|
||||
-- >>> RecordType 5 Nothing
|
||||
-- RecordType {field1 = 5, field2 = Nothing}
|
||||
|
|
@ -22,7 +22,7 @@ data AlgebraicType
|
|||
= Constructor1 Int Int
|
||||
| Constructor2 Bool (Either (Maybe Bool) Int)
|
||||
deriving (Show, Generic)
|
||||
deriving TextDump via (Generically AlgebraicType)
|
||||
deriving PrettySerialize via (Generically AlgebraicType)
|
||||
|
||||
-- >>> Constructor1 (-5) 3
|
||||
-- Constructor1 (-5) 3
|
||||
|
|
@ -13,7 +13,7 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
module Text.Dump.Serialize (Serializer, TextDump(..), run, emit) where
|
||||
module Pretty.Serialize (Serializer, PrettySerialize(..), ShowPrettySerialize, run, emit) where
|
||||
|
||||
import Data.Text.Lazy.Builder (Builder)
|
||||
import Data.Text.Lazy (Text)
|
||||
|
|
@ -140,94 +140,94 @@ inDatatype name body = do
|
|||
run :: Serializer () -> Text
|
||||
run (Serializer computeUnit) = Builder.toLazyText . builder . fst . computeUnit $ SerializerState {builder=mempty, indentation=0, increaseIndentation=(+4), currentFieldIndex=Nothing}
|
||||
|
||||
class TextDump a where
|
||||
class PrettySerialize a where
|
||||
dump :: a -> Text
|
||||
dump = run . dumpSerializer
|
||||
dumpSerializer :: a -> Serializer ()
|
||||
|
||||
newtype ShowTextDump a = ShowTextDump a
|
||||
newtype ShowPrettySerialize a = ShowPrettySerialize a
|
||||
|
||||
instance Show a => TextDump (ShowTextDump a) where
|
||||
dumpSerializer :: ShowTextDump a -> Serializer ()
|
||||
dumpSerializer = emit . fromString . show . (\ (ShowTextDump a) -> a)
|
||||
instance Show a => PrettySerialize (ShowPrettySerialize a) where
|
||||
dumpSerializer :: ShowPrettySerialize a -> Serializer ()
|
||||
dumpSerializer = emit . fromString . show . (\ (ShowPrettySerialize a) -> a)
|
||||
|
||||
deriving via ShowTextDump Int instance TextDump Int
|
||||
deriving via ShowTextDump Int8 instance TextDump Int8
|
||||
deriving via ShowTextDump Word instance TextDump Word
|
||||
deriving via ShowTextDump Bool instance TextDump Bool
|
||||
deriving via ShowTextDump Float instance TextDump Float
|
||||
deriving via ShowTextDump Int16 instance TextDump Int16
|
||||
deriving via ShowTextDump Int32 instance TextDump Int32
|
||||
deriving via ShowTextDump Int64 instance TextDump Int64
|
||||
deriving via ShowTextDump Word8 instance TextDump Word8
|
||||
deriving via ShowTextDump Double instance TextDump Double
|
||||
deriving via ShowTextDump Word16 instance TextDump Word16
|
||||
deriving via ShowTextDump Word32 instance TextDump Word32
|
||||
deriving via ShowTextDump Word64 instance TextDump Word64
|
||||
deriving via ShowTextDump Integer instance TextDump Integer
|
||||
deriving via ShowTextDump Natural instance TextDump Natural
|
||||
deriving via ShowPrettySerialize Int instance PrettySerialize Int
|
||||
deriving via ShowPrettySerialize Int8 instance PrettySerialize Int8
|
||||
deriving via ShowPrettySerialize Word instance PrettySerialize Word
|
||||
deriving via ShowPrettySerialize Bool instance PrettySerialize Bool
|
||||
deriving via ShowPrettySerialize Float instance PrettySerialize Float
|
||||
deriving via ShowPrettySerialize Int16 instance PrettySerialize Int16
|
||||
deriving via ShowPrettySerialize Int32 instance PrettySerialize Int32
|
||||
deriving via ShowPrettySerialize Int64 instance PrettySerialize Int64
|
||||
deriving via ShowPrettySerialize Word8 instance PrettySerialize Word8
|
||||
deriving via ShowPrettySerialize Double instance PrettySerialize Double
|
||||
deriving via ShowPrettySerialize Word16 instance PrettySerialize Word16
|
||||
deriving via ShowPrettySerialize Word32 instance PrettySerialize Word32
|
||||
deriving via ShowPrettySerialize Word64 instance PrettySerialize Word64
|
||||
deriving via ShowPrettySerialize Integer instance PrettySerialize Integer
|
||||
deriving via ShowPrettySerialize Natural instance PrettySerialize Natural
|
||||
|
||||
|
||||
deriving via Generically (Maybe a) instance TextDump a => TextDump (Maybe a)
|
||||
deriving via Generically (Either l r) instance (TextDump l, TextDump r) => TextDump (Either l r)
|
||||
deriving via Generically (Identity a) instance (TextDump a) => TextDump (Identity a)
|
||||
deriving via Generically (Const a b) instance (TextDump a) => TextDump (Const a b)
|
||||
deriving via Generically (Compose a b c) instance (TextDump (a (b c))) => TextDump (Compose a b c)
|
||||
deriving via Generically (Maybe a) instance PrettySerialize a => PrettySerialize (Maybe a)
|
||||
deriving via Generically (Either l r) instance (PrettySerialize l, PrettySerialize r) => PrettySerialize (Either l r)
|
||||
deriving via Generically (Identity a) instance (PrettySerialize a) => PrettySerialize (Identity a)
|
||||
deriving via Generically (Const a b) instance (PrettySerialize a) => PrettySerialize (Const a b)
|
||||
deriving via Generically (Compose a b c) instance (PrettySerialize (a (b c))) => PrettySerialize (Compose a b c)
|
||||
|
||||
class GenericTextDump self where
|
||||
class GenericPrettySerialize self where
|
||||
genericDumpSerializer :: self x -> Serializer ()
|
||||
|
||||
instance (Generic a, GenericTextDump (Rep a)) => TextDump (Generically a) where
|
||||
instance (Generic a, GenericPrettySerialize (Rep a)) => PrettySerialize (Generically a) where
|
||||
dump :: Generically a -> Text
|
||||
dump = run . dumpSerializer
|
||||
dumpSerializer :: Generically a -> Serializer ()
|
||||
dumpSerializer (Generically a) = genericDumpSerializer . from $ a
|
||||
|
||||
-- unit value
|
||||
instance GenericTextDump U1 where
|
||||
instance GenericPrettySerialize U1 where
|
||||
genericDumpSerializer :: U1 x -> Serializer ()
|
||||
genericDumpSerializer _ = pure ()
|
||||
|
||||
-- a field
|
||||
instance (TextDump a) => GenericTextDump (K1 i a) where
|
||||
instance (PrettySerialize a) => GenericPrettySerialize (K1 i a) where
|
||||
genericDumpSerializer :: K1 i a x -> Serializer ()
|
||||
genericDumpSerializer (K1 fieldValue) = dumpSerializer fieldValue
|
||||
|
||||
-- unnamed field meta
|
||||
instance GenericTextDump a => GenericTextDump (M1 tag (MetaSel Nothing isUnpacked isStrictSource isStrictCompiler) a) where
|
||||
instance GenericPrettySerialize a => GenericPrettySerialize (M1 tag (MetaSel Nothing isUnpacked isStrictSource isStrictCompiler) a) where
|
||||
genericDumpSerializer :: M1 tag (MetaSel Nothing isUnpacked isStrictSource isStrictCompiler) a x -> Serializer ()
|
||||
genericDumpSerializer (M1 f) = unnamedField (genericDumpSerializer f)
|
||||
|
||||
-- named field meta
|
||||
instance (KnownSymbol name, GenericTextDump a) => GenericTextDump (M1 tag (MetaSel (Just name) isUnpacked isStrictSource isStrictCompiler) a) where
|
||||
instance (KnownSymbol name, GenericPrettySerialize a) => GenericPrettySerialize (M1 tag (MetaSel (Just name) isUnpacked isStrictSource isStrictCompiler) a) where
|
||||
genericDumpSerializer :: M1 tag (MetaSel (Just name) isUnpacked isStrictSource isStrictCompiler) a x -> Serializer ()
|
||||
genericDumpSerializer (M1 f) = namedField (fromString fieldName) (genericDumpSerializer f)
|
||||
where
|
||||
fieldName = symbolVal (Proxy @name)
|
||||
|
||||
-- constructor metadata
|
||||
instance (GenericTextDump a, KnownSymbol name) => GenericTextDump (M1 tag (MetaCons name fixity isRecord) a) where
|
||||
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)
|
||||
where
|
||||
contructorName = symbolVal (Proxy @name)
|
||||
|
||||
-- datatype metadata
|
||||
instance (KnownSymbol name, GenericTextDump a) => GenericTextDump (M1 tag (MetaData name module_ package isNewtype) a) where
|
||||
instance (KnownSymbol name, GenericPrettySerialize a) => GenericPrettySerialize (M1 tag (MetaData name module_ package isNewtype) a) where
|
||||
genericDumpSerializer :: M1 tag (MetaData name module_ package isNewtype) a x -> Serializer ()
|
||||
genericDumpSerializer (M1 d) = inDatatype (fromString dataName) (genericDumpSerializer d)
|
||||
where
|
||||
dataName = symbolVal (Proxy @name)
|
||||
|
||||
-- sum type options
|
||||
instance (GenericTextDump l, GenericTextDump r) => GenericTextDump (l :+: r) where
|
||||
instance (GenericPrettySerialize l, GenericPrettySerialize r) => GenericPrettySerialize (l :+: r) where
|
||||
genericDumpSerializer :: (:+:) l r x -> Serializer ()
|
||||
genericDumpSerializer = \case
|
||||
L1 c -> genericDumpSerializer c
|
||||
R1 c -> genericDumpSerializer c
|
||||
|
||||
-- product type
|
||||
instance (GenericTextDump l, GenericTextDump r) => GenericTextDump (l :*: r) where
|
||||
instance (GenericPrettySerialize l, GenericPrettySerialize r) => GenericPrettySerialize (l :*: r) where
|
||||
genericDumpSerializer :: (:*:) l r x -> Serializer ()
|
||||
genericDumpSerializer (l :*: r) = do
|
||||
genericDumpSerializer l
|
||||
Loading…
Add table
Add a link
Reference in a new issue