From 126a2982b83f7fdf60a82ad58f6dcfc64c177faf Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Wed, 20 Aug 2025 17:46:48 +0200 Subject: [PATCH] refactored everything --- pretty-parse.cabal | 14 ++--- src/{Text/Dump => Pretty}/Example.hs | 8 +-- src/{Text/Dump => Pretty}/Serialize.hs | 72 +++++++++++++------------- 3 files changed, 44 insertions(+), 50 deletions(-) rename src/{Text/Dump => Pretty}/Example.hs (78%) rename src/{Text/Dump => Pretty}/Serialize.hs (68%) diff --git a/pretty-parse.cabal b/pretty-parse.cabal index faec78e..313dbfd 100644 --- a/pretty-parse.cabal +++ b/pretty-parse.cabal @@ -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 diff --git a/src/Text/Dump/Example.hs b/src/Pretty/Example.hs similarity index 78% rename from src/Text/Dump/Example.hs rename to src/Pretty/Example.hs index 0353169..ca9e7c8 100644 --- a/src/Text/Dump/Example.hs +++ b/src/Pretty/Example.hs @@ -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 diff --git a/src/Text/Dump/Serialize.hs b/src/Pretty/Serialize.hs similarity index 68% rename from src/Text/Dump/Serialize.hs rename to src/Pretty/Serialize.hs index a4dd60b..b6fe4ec 100644 --- a/src/Text/Dump/Serialize.hs +++ b/src/Pretty/Serialize.hs @@ -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