refactored everything

This commit is contained in:
vegowotenks 2025-08-20 17:46:48 +02:00
parent 883569139d
commit 126a2982b8
3 changed files with 44 additions and 50 deletions

View file

@ -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. -- 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 author: Author name here
maintainer: example@example.com maintainer: example@example.com
copyright: 2025 Author name here copyright: 2025 Author name here
license: BSD-3-Clause license: AGPL-3.0
license-file: LICENSE license-file: LICENSE
build-type: Simple build-type: Simple
extra-source-files: extra-source-files:
@ -25,12 +25,10 @@ source-repository head
library library
exposed-modules: exposed-modules:
Text.Dump.Example Pretty.Example
Text.Dump.Serialize Pretty.Serialize
other-modules: other-modules:
Paths_pretty_parse Paths_pretty_parse
autogen-modules:
Paths_pretty_parse
hs-source-dirs: hs-source-dirs:
src src
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints 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 main-is: Main.hs
other-modules: other-modules:
Paths_pretty_parse Paths_pretty_parse
autogen-modules:
Paths_pretty_parse
hs-source-dirs: hs-source-dirs:
app 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 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 main-is: Spec.hs
other-modules: other-modules:
Paths_pretty_parse Paths_pretty_parse
autogen-modules:
Paths_pretty_parse
hs-source-dirs: hs-source-dirs:
test 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 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

View file

@ -1,16 +1,16 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-} {-# LANGUAGE DerivingVia #-}
module Text.Dump.Example () where module Pretty.Example () where
import GHC.Generics import GHC.Generics
( Generic, Generically, Generically(Generically) ) ( Generic, Generically, Generically(Generically) )
import Text.Dump.Serialize (TextDump(..)) import Pretty.Serialize (PrettySerialize)
data RecordType = RecordType data RecordType = RecordType
{ field1 :: Int { field1 :: Int
, field2 :: Maybe Bool , field2 :: Maybe Bool
} }
deriving (Show, Generic) deriving (Show, Generic)
deriving TextDump via (Generically RecordType) deriving PrettySerialize via (Generically RecordType)
-- >>> RecordType 5 Nothing -- >>> RecordType 5 Nothing
-- RecordType {field1 = 5, field2 = Nothing} -- RecordType {field1 = 5, field2 = Nothing}
@ -22,7 +22,7 @@ data AlgebraicType
= Constructor1 Int Int = Constructor1 Int Int
| Constructor2 Bool (Either (Maybe Bool) Int) | Constructor2 Bool (Either (Maybe Bool) Int)
deriving (Show, Generic) deriving (Show, Generic)
deriving TextDump via (Generically AlgebraicType) deriving PrettySerialize via (Generically AlgebraicType)
-- >>> Constructor1 (-5) 3 -- >>> Constructor1 (-5) 3
-- Constructor1 (-5) 3 -- Constructor1 (-5) 3

View file

@ -13,7 +13,7 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DerivingVia #-} {-# 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.Builder (Builder)
import Data.Text.Lazy (Text) import Data.Text.Lazy (Text)
@ -140,94 +140,94 @@ inDatatype name body = do
run :: Serializer () -> Text run :: Serializer () -> Text
run (Serializer computeUnit) = Builder.toLazyText . builder . fst . computeUnit $ SerializerState {builder=mempty, indentation=0, increaseIndentation=(+4), currentFieldIndex=Nothing} 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 :: a -> Text
dump = run . dumpSerializer dump = run . dumpSerializer
dumpSerializer :: a -> Serializer () dumpSerializer :: a -> Serializer ()
newtype ShowTextDump a = ShowTextDump a newtype ShowPrettySerialize a = ShowPrettySerialize a
instance Show a => TextDump (ShowTextDump a) where instance Show a => PrettySerialize (ShowPrettySerialize a) where
dumpSerializer :: ShowTextDump a -> Serializer () dumpSerializer :: ShowPrettySerialize a -> Serializer ()
dumpSerializer = emit . fromString . show . (\ (ShowTextDump a) -> a) dumpSerializer = emit . fromString . show . (\ (ShowPrettySerialize a) -> a)
deriving via ShowTextDump Int instance TextDump Int deriving via ShowPrettySerialize Int instance PrettySerialize Int
deriving via ShowTextDump Int8 instance TextDump Int8 deriving via ShowPrettySerialize Int8 instance PrettySerialize Int8
deriving via ShowTextDump Word instance TextDump Word deriving via ShowPrettySerialize Word instance PrettySerialize Word
deriving via ShowTextDump Bool instance TextDump Bool deriving via ShowPrettySerialize Bool instance PrettySerialize Bool
deriving via ShowTextDump Float instance TextDump Float deriving via ShowPrettySerialize Float instance PrettySerialize Float
deriving via ShowTextDump Int16 instance TextDump Int16 deriving via ShowPrettySerialize Int16 instance PrettySerialize Int16
deriving via ShowTextDump Int32 instance TextDump Int32 deriving via ShowPrettySerialize Int32 instance PrettySerialize Int32
deriving via ShowTextDump Int64 instance TextDump Int64 deriving via ShowPrettySerialize Int64 instance PrettySerialize Int64
deriving via ShowTextDump Word8 instance TextDump Word8 deriving via ShowPrettySerialize Word8 instance PrettySerialize Word8
deriving via ShowTextDump Double instance TextDump Double deriving via ShowPrettySerialize Double instance PrettySerialize Double
deriving via ShowTextDump Word16 instance TextDump Word16 deriving via ShowPrettySerialize Word16 instance PrettySerialize Word16
deriving via ShowTextDump Word32 instance TextDump Word32 deriving via ShowPrettySerialize Word32 instance PrettySerialize Word32
deriving via ShowTextDump Word64 instance TextDump Word64 deriving via ShowPrettySerialize Word64 instance PrettySerialize Word64
deriving via ShowTextDump Integer instance TextDump Integer deriving via ShowPrettySerialize Integer instance PrettySerialize Integer
deriving via ShowTextDump Natural instance TextDump Natural deriving via ShowPrettySerialize Natural instance PrettySerialize Natural
deriving via Generically (Maybe a) instance TextDump a => TextDump (Maybe a) deriving via Generically (Maybe a) instance PrettySerialize a => PrettySerialize (Maybe a)
deriving via Generically (Either l r) instance (TextDump l, TextDump r) => TextDump (Either l r) deriving via Generically (Either l r) instance (PrettySerialize l, PrettySerialize r) => PrettySerialize (Either l r)
deriving via Generically (Identity a) instance (TextDump a) => TextDump (Identity a) deriving via Generically (Identity a) instance (PrettySerialize a) => PrettySerialize (Identity a)
deriving via Generically (Const a b) instance (TextDump a) => TextDump (Const a b) deriving via Generically (Const a b) instance (PrettySerialize a) => PrettySerialize (Const a b)
deriving via Generically (Compose a b c) instance (TextDump (a (b c))) => TextDump (Compose a b c) 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 () 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 :: Generically a -> Text
dump = run . dumpSerializer dump = run . dumpSerializer
dumpSerializer :: Generically a -> Serializer () dumpSerializer :: Generically a -> Serializer ()
dumpSerializer (Generically a) = genericDumpSerializer . from $ a dumpSerializer (Generically a) = genericDumpSerializer . from $ a
-- unit value -- unit value
instance GenericTextDump U1 where instance GenericPrettySerialize U1 where
genericDumpSerializer :: U1 x -> Serializer () genericDumpSerializer :: U1 x -> Serializer ()
genericDumpSerializer _ = pure () genericDumpSerializer _ = pure ()
-- a field -- 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 i a x -> Serializer ()
genericDumpSerializer (K1 fieldValue) = dumpSerializer fieldValue genericDumpSerializer (K1 fieldValue) = dumpSerializer fieldValue
-- unnamed field meta -- 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 tag (MetaSel Nothing isUnpacked isStrictSource isStrictCompiler) a x -> Serializer ()
genericDumpSerializer (M1 f) = unnamedField (genericDumpSerializer f) genericDumpSerializer (M1 f) = unnamedField (genericDumpSerializer f)
-- named field meta -- 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 tag (MetaSel (Just name) isUnpacked isStrictSource isStrictCompiler) a x -> Serializer ()
genericDumpSerializer (M1 f) = namedField (fromString fieldName) (genericDumpSerializer f) genericDumpSerializer (M1 f) = namedField (fromString fieldName) (genericDumpSerializer f)
where where
fieldName = symbolVal (Proxy @name) fieldName = symbolVal (Proxy @name)
-- constructor metadata -- 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 tag (MetaCons name fixity isRecord) a x -> Serializer ()
genericDumpSerializer (M1 c) = inConstructor (fromString contructorName) (genericDumpSerializer c) genericDumpSerializer (M1 c) = inConstructor (fromString contructorName) (genericDumpSerializer c)
where where
contructorName = symbolVal (Proxy @name) contructorName = symbolVal (Proxy @name)
-- datatype metadata -- 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 tag (MetaData name module_ package isNewtype) a x -> Serializer ()
genericDumpSerializer (M1 d) = inDatatype (fromString dataName) (genericDumpSerializer d) genericDumpSerializer (M1 d) = inDatatype (fromString dataName) (genericDumpSerializer d)
where where
dataName = symbolVal (Proxy @name) dataName = symbolVal (Proxy @name)
-- sum type options -- 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 :: (:+:) l r x -> Serializer ()
genericDumpSerializer = \case genericDumpSerializer = \case
L1 c -> genericDumpSerializer c L1 c -> genericDumpSerializer c
R1 c -> genericDumpSerializer c R1 c -> genericDumpSerializer c
-- product type -- 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 x -> Serializer ()
genericDumpSerializer (l :*: r) = do genericDumpSerializer (l :*: r) = do
genericDumpSerializer l genericDumpSerializer l