From 831d7a578724b992aae24ec4023007e5d6063f3f Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Wed, 20 Aug 2025 16:49:06 +0200 Subject: [PATCH 1/8] feat: show Magic --- src/Language/Java/Classfile/Magic.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Language/Java/Classfile/Magic.hs b/src/Language/Java/Classfile/Magic.hs index 9d75142..e0dfd86 100644 --- a/src/Language/Java/Classfile/Magic.hs +++ b/src/Language/Java/Classfile/Magic.hs @@ -6,6 +6,7 @@ {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} module Language.Java.Classfile.Magic (Magic(..)) where import Data.Word (Word32) import Language.Java.Classfile.Extractable (Extractable, extract, expectConstant) @@ -21,6 +22,8 @@ data Magic stage where Magic :: Hex Word32 -> Magic Parse Cafebabe :: Magic Resolve +deriving instance Show (Magic stage) + instance Extractable (Magic Parse) where extract :: Extract (Magic Parse) extract = Magic . Hex <$> expectConstant 0xCAFEBABE From 6517b69fd84e4edca8e218a6091a41c5b9511271 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Wed, 20 Aug 2025 16:49:23 +0200 Subject: [PATCH 2/8] feat: MonadPlus instance for Extract --- src/Language/Java/Classfile/Extract.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/Language/Java/Classfile/Extract.hs b/src/Language/Java/Classfile/Extract.hs index d837cc7..607d4b0 100644 --- a/src/Language/Java/Classfile/Extract.hs +++ b/src/Language/Java/Classfile/Extract.hs @@ -2,19 +2,25 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DeriveAnyClass #-} module Language.Java.Classfile.Extract (Extract(), bytes, runExtract, expectRaw, expectEqual, traceType, traceConstructor, traceField, traceIndex, Reason(..), Trace(..), Expected(..), Actual(..), TypeName(..)) where -import Data.ByteString.Lazy (ByteString) -import qualified Data.ByteString.Lazy as ByteString import Control.Applicative (Alternative (empty, (<|>))) +import Control.Monad (MonadPlus) + +import Data.ByteString.Lazy (ByteString) import Data.Text (Text) -import qualified Data.Text as Text import Data.Typeable (Typeable, typeOf) +import qualified Data.ByteString.Lazy as ByteString +import qualified Data.Text as Text + -- | Extractor Monad. Computations running in this monad will automatically keep track of used resources and backtrack arbitrarily. newtype Extract a = Extract (Continuation a) deriving (Functor) + deriving anyclass MonadPlus -- | Functions work wonders when defining monads. From c1d4f93f0ec17ec42ff2aebbbba697f215cab007 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Wed, 20 Aug 2025 17:26:57 +0200 Subject: [PATCH 3/8] bumped nightly to lts version --- stack.yaml | 3 ++- stack.yaml.lock | 9 +++++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/stack.yaml b/stack.yaml index 1bd568c..d2efd23 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,7 +17,8 @@ # # snapshot: ./custom-snapshot.yaml # snapshot: https://example.com/snapshots/2024-01-01.yaml -snapshot: nightly-2025-07-10 +snapshot: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/3.yaml compiler: ghc-9.12.1 # User packages to be built. diff --git a/stack.yaml.lock b/stack.yaml.lock index 8c511db..74f9d6d 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -6,7 +6,8 @@ packages: [] snapshots: - completed: - sha256: 39e3a4dc79edf153bb0aa6dc4206b1543c0e0f3e3811ec751abdcdf3aaf08887 - size: 723871 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2025/7/10.yaml - original: nightly-2025-07-10 + sha256: aa97dce5253937e4aa56100a0a9dc1f79a554cf543ad7cfab0afe6ed42de2f31 + size: 724941 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/3.yaml + original: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/3.yaml From 603e9b1d53bf9ec43c08f0b7f4d0c03c0e130486 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Wed, 20 Aug 2025 17:27:10 +0200 Subject: [PATCH 4/8] feat[ClassFlag]: comments on meaning --- src/Language/Java/Classfile.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Language/Java/Classfile.hs b/src/Language/Java/Classfile.hs index 74251e6..81c02de 100644 --- a/src/Language/Java/Classfile.hs +++ b/src/Language/Java/Classfile.hs @@ -59,15 +59,15 @@ newtype instance ClassFlags Parse = ClassFlags (Flags ClassFlag) deriving Extractable via Generically (ClassFlags Parse) data ClassFlag - = Public - | Final - | Super - | Interface - | Abstract - | Synthetic - | Annotation - | Enum - | Module + = Public -- may be accessed from outside the package + | Final -- no subclasses allowed + | Super -- treat superclass methods special when using InvokeSpecial + | Interface -- is an interface + | Abstract -- abstract, must not be instantiated + | Synthetic -- not present in source code + | Annotation -- is annotation interface + | Enum -- enumerated instances + | Module -- module, not a class deriving (Show, Eq, Ord, Enum, Bounded) instance FlagMask ClassFlag where From 4e2d2e9b9882d3c86b39f4459caaf8dd12985125 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Wed, 20 Aug 2025 17:27:24 +0200 Subject: [PATCH 5/8] feat[FlagMask]: default signature with generic ofMask --- src/Language/Java/Classfile/Flags.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/src/Language/Java/Classfile/Flags.hs b/src/Language/Java/Classfile/Flags.hs index 9a2e549..b52c725 100644 --- a/src/Language/Java/Classfile/Flags.hs +++ b/src/Language/Java/Classfile/Flags.hs @@ -6,10 +6,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} -module Language.Java.Classfile.Flags (Flags(..), FlagMask(..)) where +{-# LANGUAGE DefaultSignatures #-} +module Language.Java.Classfile.Flags (Flags(..), FlagMask(..), containsFlag) where -import Data.Bits (Bits((.&.))) +import Data.Bits (Bits((.&.), zeroBits)) import Data.Enum.Util (enumerate) import Data.Set (Set) @@ -18,6 +19,8 @@ import qualified Data.Set as Set import Language.Java.Classfile.Extract (Extract) import Language.Java.Classfile.Extractable (Extractable (extract)) import Data.Kind (Type) +import Control.Arrow ((>>>)) +import qualified Data.List as List -- | Using the 'FlagMask' instance of the type parameter, this will extract all the flags whose mask produced a non-zero value using '.&.' @@ -39,3 +42,13 @@ class FlagMask a where type FlagType a :: Type maskOf :: a -> FlagType a + ofMask :: FlagType a -> Set a + + default ofMask :: (Enum a, Bounded a, Ord a, Bits (FlagType a)) => FlagType a -> Set a + ofMask mask = List.filter (containsFlag mask) + >>> Set.fromList + $ enumerate @a + +containsFlag :: (Bits (FlagType a), FlagMask a) => FlagType a -> a -> Bool +containsFlag mask flag = mask .&. maskOf flag /= zeroBits + From b82ce2646b070f2ce3e506c45337351fdbdb26fe Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Wed, 20 Aug 2025 17:28:55 +0200 Subject: [PATCH 6/8] feat[ClassFlag]: Haddock comments --- src/Language/Java/Classfile.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Language/Java/Classfile.hs b/src/Language/Java/Classfile.hs index 81c02de..f85dff8 100644 --- a/src/Language/Java/Classfile.hs +++ b/src/Language/Java/Classfile.hs @@ -59,15 +59,15 @@ newtype instance ClassFlags Parse = ClassFlags (Flags ClassFlag) deriving Extractable via Generically (ClassFlags Parse) data ClassFlag - = Public -- may be accessed from outside the package - | Final -- no subclasses allowed - | Super -- treat superclass methods special when using InvokeSpecial - | Interface -- is an interface - | Abstract -- abstract, must not be instantiated - | Synthetic -- not present in source code - | Annotation -- is annotation interface - | Enum -- enumerated instances - | Module -- module, not a class + = Public -- ^ may be accessed from outside the package + | Final -- ^ no subclasses allowed + | Super -- ^ treat superclass methods special when using InvokeSpecial + | Interface -- ^ is an interface + | Abstract -- ^ abstract, must not be instantiated + | Synthetic -- ^ not present in source code + | Annotation -- ^ is annotation interface + | Enum -- ^ enumerated instances + | Module -- ^ module, not a class deriving (Show, Eq, Ord, Enum, Bounded) instance FlagMask ClassFlag where From 5e6736e8da89595061664f82f627872411dc86b2 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Wed, 20 Aug 2025 19:25:26 +0200 Subject: [PATCH 7/8] feat[classfile]: PrettySerialize instances only a little bit broken formatting --- .gitmodules | 3 +++ 3rdparty/pretty-parse | 1 + app/Main.hs | 4 +++- java-classfile.cabal | 17 ++++++-------- package.yaml | 11 +++++++--- src/Language/Java/Classfile.hs | 6 ++++- src/Language/Java/Classfile/Attributes.hs | 5 +++-- src/Language/Java/Classfile/ConstantPool.hs | 17 +++++++++----- .../Java/Classfile/ConstantPool/Entry.hs | 5 +++++ .../Java/Classfile/ConstantPool/References.hs | 21 +++++++++++++----- src/Language/Java/Classfile/Extract.hs | 22 ++++++++++++++----- .../Java/Classfile/Extractable/SizedBytes.hs | 4 +++- .../Java/Classfile/Extractable/WithTag.hs | 3 ++- src/Language/Java/Classfile/Fields.hs | 8 ++++--- src/Language/Java/Classfile/Flags.hs | 8 ++++++- src/Language/Java/Classfile/Interfaces.hs | 3 ++- src/Language/Java/Classfile/Magic.hs | 3 +++ src/Language/Java/Classfile/Methods.hs | 8 ++++--- src/Language/Java/Classfile/Version.hs | 3 ++- stack.yaml | 1 + 20 files changed, 108 insertions(+), 45 deletions(-) create mode 100644 .gitmodules create mode 160000 3rdparty/pretty-parse diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..fcebd5e --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "3rdparty/pretty-parse"] + path = 3rdparty/pretty-parse + url = https://git.jossco.de/vegowotenks/pretty-parse diff --git a/3rdparty/pretty-parse b/3rdparty/pretty-parse new file mode 160000 index 0000000..93473c9 --- /dev/null +++ b/3rdparty/pretty-parse @@ -0,0 +1 @@ +Subproject commit 93473c9ac69c20053d9fbe1b8a0ee199980cc435 diff --git a/app/Main.hs b/app/Main.hs index aee2853..bf84882 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,6 +4,8 @@ module Main (main) where import Data.ByteString.Lazy qualified as ByteString +import Data.Text.Lazy.IO qualified as LazyTextIO +import Pretty.Serialize qualified as Pretty import Language.Java.Classfile (Classfile) import Language.Java.Classfile.Extract (runExtract) @@ -13,4 +15,4 @@ import Language.Java.Classfile.Stage (Stage(Parse)) main :: IO () main = do input <- ByteString.getContents - print $ runExtract input (extract @(Classfile Parse)) + LazyTextIO.putStrLn . Pretty.serialize $ runExtract input (extract @(Classfile Parse)) diff --git a/java-classfile.cabal b/java-classfile.cabal index c47d7a3..20de1a3 100644 --- a/java-classfile.cabal +++ b/java-classfile.cabal @@ -44,12 +44,13 @@ library Paths_java_classfile 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 + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages build-depends: array , base >=4.7 && <5 , bytestring , containers + , pretty-parse , text default-language: Haskell2010 @@ -59,13 +60,12 @@ executable java-classfile-exe Paths_java_classfile 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 + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages -threaded -rtsopts -with-rtsopts=-N build-depends: - array - , base >=4.7 && <5 + base >=4.7 && <5 , bytestring - , containers , java-classfile + , pretty-parse , text default-language: Haskell2010 @@ -76,12 +76,9 @@ test-suite java-classfile-test Paths_java_classfile 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 + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages -threaded -rtsopts -with-rtsopts=-N build-depends: - array - , base >=4.7 && <5 + base >=4.7 && <5 , bytestring - , containers , java-classfile - , text default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 7a15bf3..022edb1 100644 --- a/package.yaml +++ b/package.yaml @@ -19,11 +19,8 @@ synopsis: Multi-Stage classfile parsing and verification. description: Please see the README on Forgejo at dependencies: -- array - base >= 4.7 && < 5 - bytestring -- containers -- text ghc-options: - -Wall @@ -35,9 +32,15 @@ ghc-options: - -Wmissing-home-modules - -Wpartial-fields - -Wredundant-constraints +- -Wunused-packages library: source-dirs: src + dependencies: + - array + - containers + - pretty-parse + - text executables: java-classfile-exe: @@ -49,6 +52,8 @@ executables: - -with-rtsopts=-N dependencies: - java-classfile + - pretty-parse + - text tests: java-classfile-test: diff --git a/src/Language/Java/Classfile.hs b/src/Language/Java/Classfile.hs index f85dff8..ae5b1c1 100644 --- a/src/Language/Java/Classfile.hs +++ b/src/Language/Java/Classfile.hs @@ -29,6 +29,7 @@ import Language.Java.Classfile.Fields (Fields) import Language.Java.Classfile.Methods (Methods) import Language.Java.Classfile.Attributes (Attributes) import Data.Word (Word16) +import Pretty.Serialize (PrettySerialize) -- | 'Stage'-indexed classfile. It can represent a class, an interface or a module. @@ -50,6 +51,7 @@ data Classfile stage = Classfile deriving instance (Show (Magic stage), Show (ConstantPool stage), Show (ClassFlags stage), Show (Class stage)) => Show (Classfile stage) deriving via Generically (Classfile Parse) instance (Extractable (Classfile Parse)) +deriving via Generically (Classfile Parse) instance (PrettySerialize (Classfile Parse)) type ClassFlags :: Stage -> Type data family ClassFlags stage @@ -57,6 +59,7 @@ data family ClassFlags stage newtype instance ClassFlags Parse = ClassFlags (Flags ClassFlag) deriving stock (Show, Generic) deriving Extractable via Generically (ClassFlags Parse) + deriving PrettySerialize via Generically (ClassFlags Parse) data ClassFlag = Public -- ^ may be accessed from outside the package @@ -68,7 +71,8 @@ data ClassFlag | Annotation -- ^ is annotation interface | Enum -- ^ enumerated instances | Module -- ^ module, not a class - deriving (Show, Eq, Ord, Enum, Bounded) + deriving (Show, Eq, Ord, Enum, Bounded, Generic) + deriving PrettySerialize via Generically ClassFlag instance FlagMask ClassFlag where type FlagType ClassFlag = Word16 diff --git a/src/Language/Java/Classfile/Attributes.hs b/src/Language/Java/Classfile/Attributes.hs index 7466c04..6d3d586 100644 --- a/src/Language/Java/Classfile/Attributes.hs +++ b/src/Language/Java/Classfile/Attributes.hs @@ -10,6 +10,7 @@ import Language.Java.Classfile.Extractable (Extractable) import Language.Java.Classfile.ConstantPool.References (Utf8Reference) import Language.Java.Classfile.Extractable.SizedBytes (SizedBytes) import GHC.Generics ( Generic, Generically(..) ) +import Pretty.Serialize (PrettySerialize) -- | Generic Attribute array used everywhere. -- @@ -17,7 +18,7 @@ import GHC.Generics ( Generic, Generically(..) ) newtype Attributes = Attributes (Array Word16 Attribute) deriving stock (Show) - deriving newtype Extractable + deriving newtype (Extractable, PrettySerialize) -- | Unknown Attribute @@ -26,4 +27,4 @@ data Attribute = Attribute , info :: SizedBytes Word32 } deriving stock (Show, Generic) - deriving Extractable via Generically Attribute + deriving (Extractable, PrettySerialize) via Generically Attribute diff --git a/src/Language/Java/Classfile/ConstantPool.hs b/src/Language/Java/Classfile/ConstantPool.hs index a0cf35d..3a32fcd 100644 --- a/src/Language/Java/Classfile/ConstantPool.hs +++ b/src/Language/Java/Classfile/ConstantPool.hs @@ -1,6 +1,5 @@ -- | THE constant pool, all the constants in a class file are handled in here. -{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} @@ -10,6 +9,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DeriveGeneric #-} module Language.Java.Classfile.ConstantPool (ConstantPool(..)) where import Data.Word (Word16) import Data.Array.IArray (Array, listArray) @@ -19,13 +20,19 @@ import Language.Java.Classfile.Extract (Extract, traceIndex, traceType) import qualified Data.Text as Text import Language.Java.Classfile.Stage (Stage(..)) import Data.Kind (Type) +import GHC.Generics (Generically(..), Generic) +import Pretty.Serialize (PrettySerialize) type ConstantPool :: Stage -> Type -data ConstantPool stage where - ConstantPool :: (Array Word16 Entry) -> ConstantPool Parse - NoPool :: ConstantPool Resolve +data family ConstantPool stage + +newtype instance ConstantPool Parse = ConstantPool (Array Word16 Entry) + deriving stock (Generic, Show) + +deriving via (Generically (ConstantPool Parse)) instance PrettySerialize (ConstantPool Parse) + +data instance ConstantPool Resolve = NoPool -deriving instance Show (ConstantPool stage) -- | 'Stage'-indexed constant-pool. The constant-pool is erased after resolving the class file. diff --git a/src/Language/Java/Classfile/ConstantPool/Entry.hs b/src/Language/Java/Classfile/ConstantPool/Entry.hs index ff98f7b..8c6e07b 100644 --- a/src/Language/Java/Classfile/ConstantPool/Entry.hs +++ b/src/Language/Java/Classfile/ConstantPool/Entry.hs @@ -8,6 +8,7 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OrPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Language.Java.Classfile.ConstantPool.Entry (Entry(..), StorageCount(..), storageCount, MethodHandleInfo(..)) where import GHC.Generics (Generic, Generically(..)) import Language.Java.Classfile.Extractable (Extractable (extract)) @@ -20,6 +21,7 @@ import Language.Java.Classfile.Extract (Extract, bytes) import qualified Data.Text.Encoding as Text import qualified Data.ByteString.Lazy as ByteString import qualified Data.ByteString as StrictByteString +import Pretty.Serialize (PrettySerialize) -- | A single entry. Double and Long are not followed by something unusable, they are duplicated instead. @@ -60,6 +62,7 @@ data Entry -- ^ Some package description deriving stock (Show, Generic) deriving Extractable via Generically Entry + deriving PrettySerialize via Generically Entry -- | Holds the invariants of MethodHandles (Only certain references are allowed after some kinds) -- @@ -68,11 +71,13 @@ data Entry data MethodHandleInfo = MethodHandleInfo MethodHandleReferenceKind OpaqueReference deriving stock (Show, Generic) deriving Extractable via Generically MethodHandleInfo + deriving PrettySerialize via Generically MethodHandleInfo -- | Extractor newtype for a java-utf-text with size tag specified as a type argument. newtype SizedText sizeType = SizedText Text deriving stock (Show) + deriving newtype PrettySerialize instance (Integral sizeType, Extractable sizeType) => Extractable (SizedText sizeType) where extract :: Extract (SizedText sizeType) diff --git a/src/Language/Java/Classfile/ConstantPool/References.hs b/src/Language/Java/Classfile/ConstantPool/References.hs index 1cf94b4..10829b5 100644 --- a/src/Language/Java/Classfile/ConstantPool/References.hs +++ b/src/Language/Java/Classfile/ConstantPool/References.hs @@ -7,6 +7,7 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE DeriveGeneric #-} module Language.Java.Classfile.ConstantPool.References (Utf8Reference(..), ClassReference(..), NameAndTypeReference(..), MethodHandleReferenceKind(..), OpaqueReference(..), BootstrapMethodIndex(..), Class) where import Data.Word (Word16, Word8) import Language.Java.Classfile.Extractable (Extractable) @@ -14,12 +15,15 @@ import Language.Java.Classfile.Extractable.AsTag ( TagValue(..), AsTag, AsTag(..) ) import Language.Java.Classfile.Stage (Stage(..)) import Data.Kind (Type) +import Pretty.Serialize (PrettySerialize) +import GHC.Generics (Generically(..), Generic) -- | Wrapper for constant-pool reference to text. newtype Utf8Reference = Utf8Reference Word16 - deriving stock (Show) + deriving stock (Show, Generic) deriving newtype Extractable + deriving PrettySerialize via Generically Utf8Reference -- | 'Stage'-indexed type, either a Class or only a t'ClassReference'. @@ -30,26 +34,30 @@ type family Class stage where -- | Reference to a class in a constant-pool. This will resolve into a class. newtype ClassReference = ClassReference Word16 - deriving stock (Show) + deriving stock (Show, Generic) deriving newtype Extractable + deriving PrettySerialize via Generically ClassReference -- | Reference to a class in a constant-pool. This will resolve to Name and Type. newtype NameAndTypeReference = NameAndTypeReference Word16 - deriving stock (Show) + deriving stock (Show, Generic) deriving newtype Extractable + deriving PrettySerialize via Generically NameAndTypeReference -- | Reference to something in a constant-pool. I will hopefully get rid of this type. newtype OpaqueReference = OpaqueReference Word16 - deriving stock (Show) + deriving stock (Show, Generic) deriving newtype Extractable + deriving PrettySerialize via Generically OpaqueReference -- | Reference to a method in the BootstrapMethods class attribute newtype BootstrapMethodIndex = BootstrapMethodIndex Word16 - deriving stock (Show) + deriving stock (Show, Generic) deriving newtype Extractable + deriving PrettySerialize via Generically BootstrapMethodIndex -- | A Tag used to determine the type of a MethodHandle @@ -63,8 +71,9 @@ data MethodHandleReferenceKind | InvokeSpecial | NewInvokeSpecial | InvokeInterface - deriving stock (Show, Enum, Bounded) + deriving stock (Show, Enum, Bounded, Generic) deriving Extractable via AsTag MethodHandleReferenceKind + deriving PrettySerialize via Generically MethodHandleReferenceKind instance TagValue MethodHandleReferenceKind where type TagType MethodHandleReferenceKind = Word8 diff --git a/src/Language/Java/Classfile/Extract.hs b/src/Language/Java/Classfile/Extract.hs index 607d4b0..bf7fdc9 100644 --- a/src/Language/Java/Classfile/Extract.hs +++ b/src/Language/Java/Classfile/Extract.hs @@ -2,17 +2,22 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DeriveGeneric #-} module Language.Java.Classfile.Extract (Extract(), bytes, runExtract, expectRaw, expectEqual, traceType, traceConstructor, traceField, traceIndex, Reason(..), Trace(..), Expected(..), Actual(..), TypeName(..)) where import Control.Applicative (Alternative (empty, (<|>))) import Control.Monad (MonadPlus) +import GHC.Generics (Generic, Generically(..)) + import Data.ByteString.Lazy (ByteString) import Data.Text (Text) import Data.Typeable (Typeable, typeOf) +import Pretty.Serialize (PrettySerialize) + import qualified Data.ByteString.Lazy as ByteString import qualified Data.Text as Text @@ -35,15 +40,18 @@ data Reply a -- | Type Alias for the Show instance newtype Expected = Expected Text - deriving Show + deriving stock (Show, Generic) + deriving PrettySerialize via Generically Expected -- | Type Alias for the Show instance newtype Actual = Actual Text - deriving Show + deriving stock (Show, Generic) + deriving PrettySerialize via Generically Actual -- | Type Alias for the Show instance newtype TypeName = TypeName Text - deriving Show + deriving stock (Show, Generic) + deriving PrettySerialize via Generically TypeName -- | Why did the computation fail? @@ -56,7 +64,8 @@ data Reason -- ^ Something else went wrong | Unknown -- ^ Someone used the 'empty' function from 'Alternative' - deriving Show + deriving stock (Show, Generic) + deriving PrettySerialize via Generically Reason -- | Where did the computation fail? Calls to these functions are auto-generated by the Generic instances. @@ -65,7 +74,8 @@ data Trace | InConstructor Text | InField Text | AtIndex Word - deriving Show + deriving stock (Show, Generic) + deriving PrettySerialize via Generically Trace instance Applicative Extract where -- | Don't consume any input diff --git a/src/Language/Java/Classfile/Extractable/SizedBytes.hs b/src/Language/Java/Classfile/Extractable/SizedBytes.hs index eb80393..300f6db 100644 --- a/src/Language/Java/Classfile/Extractable/SizedBytes.hs +++ b/src/Language/Java/Classfile/Extractable/SizedBytes.hs @@ -1,20 +1,22 @@ -- | Read arbitrary bytes prefixed with a length. -{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DerivingVia #-} module Language.Java.Classfile.Extractable.SizedBytes (SizedBytes(..)) where import Data.ByteString (ByteString) import Language.Java.Classfile.Extractable (Extractable (..)) import Language.Java.Classfile.Extract (Extract, bytes) import qualified Data.ByteString as StrictByteString import qualified Data.ByteString.Lazy as ByteString +import Pretty.Serialize (PrettySerialize, ShowPrettySerialize(..)) -- | The sizeType type Paramter is used to extract the correct byte count. newtype SizedBytes sizeType = SizedBytes ByteString deriving stock Show + deriving PrettySerialize via ShowPrettySerialize (SizedBytes sizeType) instance (Extractable sizeType, Integral sizeType) => Extractable (SizedBytes sizeType) where extract :: Extract (SizedBytes sizeType) diff --git a/src/Language/Java/Classfile/Extractable/WithTag.hs b/src/Language/Java/Classfile/Extractable/WithTag.hs index d2759e4..bcd74ae 100644 --- a/src/Language/Java/Classfile/Extractable/WithTag.hs +++ b/src/Language/Java/Classfile/Extractable/WithTag.hs @@ -16,6 +16,7 @@ import Control.Monad (void) import Data.Proxy (Proxy(Proxy)) import Data.Typeable ( Typeable ) import Data.Word (Word8) +import Pretty.Serialize (PrettySerialize) -- | Type alias if you use the same type a lot. @@ -25,7 +26,7 @@ type Word8Tag value a = WithNumericTag value Word8 a type WithNumericTag :: Natural -> Type -> Type -> Type newtype WithNumericTag value tagType a = Tagged a - deriving newtype Show + deriving newtype (Show, PrettySerialize) instance (KnownNat value, Extractable a, Extractable tagType, Eq tagType, Num tagType, Show tagType, Typeable tagType) => Extractable (WithNumericTag value tagType a) where extract :: Extract (WithNumericTag value tagType a) diff --git a/src/Language/Java/Classfile/Fields.hs b/src/Language/Java/Classfile/Fields.hs index ea9ffc8..79af340 100644 --- a/src/Language/Java/Classfile/Fields.hs +++ b/src/Language/Java/Classfile/Fields.hs @@ -14,12 +14,13 @@ import GHC.Generics ( Generically, Generic, Generically(..) ) import Language.Java.Classfile.Flags (Flags, FlagMask (..)) import Language.Java.Classfile.ConstantPool.References (Utf8Reference) import Language.Java.Classfile.Attributes (Attributes) +import Pretty.Serialize (PrettySerialize) -- | Word16-Array of Fields. newtype Fields = Fields (Array Word16 Field) deriving stock Show - deriving newtype Extractable + deriving newtype (Extractable, PrettySerialize) -- | All the access flags a field can have @@ -33,7 +34,8 @@ data FieldFlag | Transient | Synthetic | Enumeration -- original "Enum" - deriving stock (Show, Eq, Ord, Enum, Bounded) + deriving stock (Show, Eq, Ord, Enum, Bounded, Generic) + deriving PrettySerialize via Generically FieldFlag instance FlagMask FieldFlag where type FlagType FieldFlag = Word16 @@ -58,4 +60,4 @@ data Field = Field , attribute :: Attributes } deriving stock (Show, Generic) - deriving Extractable via Generically Field + deriving (Extractable, PrettySerialize) via Generically Field diff --git a/src/Language/Java/Classfile/Flags.hs b/src/Language/Java/Classfile/Flags.hs index b52c725..c067a82 100644 --- a/src/Language/Java/Classfile/Flags.hs +++ b/src/Language/Java/Classfile/Flags.hs @@ -7,6 +7,9 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE StandaloneDeriving #-} module Language.Java.Classfile.Flags (Flags(..), FlagMask(..), containsFlag) where @@ -21,11 +24,14 @@ import Language.Java.Classfile.Extractable (Extractable (extract)) import Data.Kind (Type) import Control.Arrow ((>>>)) import qualified Data.List as List +import GHC.Generics (Generic, Generically(..)) +import Pretty.Serialize (PrettySerialize) -- | Using the 'FlagMask' instance of the type parameter, this will extract all the flags whose mask produced a non-zero value using '.&.' newtype Flags a = Flags (Set a) - deriving (Show) + deriving (Show, Generic) +deriving via Generically (Flags a) instance (PrettySerialize (Set a)) => PrettySerialize (Flags a) instance (Extractable (FlagType a), Bounded a, Enum a, Ord a, FlagMask a, Bits (FlagType a), Num (FlagType a)) => Extractable (Flags a) where extract :: Extract (Flags a) diff --git a/src/Language/Java/Classfile/Interfaces.hs b/src/Language/Java/Classfile/Interfaces.hs index 6908287..f1af737 100644 --- a/src/Language/Java/Classfile/Interfaces.hs +++ b/src/Language/Java/Classfile/Interfaces.hs @@ -8,9 +8,10 @@ import Data.Word (Word16) import Language.Java.Classfile.ConstantPool.References (ClassReference) import Language.Java.Classfile.Extractable (Extractable) import GHC.Generics ( Generic, Generically, Generically(..) ) +import Pretty.Serialize (PrettySerialize) -- | A list of classes something implements. newtype Interfaces = Interfaces (Array Word16 ClassReference) deriving stock (Show, Generic) - deriving Extractable via Generically Interfaces + deriving (Extractable, PrettySerialize) via Generically Interfaces diff --git a/src/Language/Java/Classfile/Magic.hs b/src/Language/Java/Classfile/Magic.hs index e0dfd86..44c713d 100644 --- a/src/Language/Java/Classfile/Magic.hs +++ b/src/Language/Java/Classfile/Magic.hs @@ -7,6 +7,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DerivingVia #-} module Language.Java.Classfile.Magic (Magic(..)) where import Data.Word (Word32) import Language.Java.Classfile.Extractable (Extractable, extract, expectConstant) @@ -14,6 +15,7 @@ import Language.Java.Classfile.Extract (Extract) import Data.Hex (Hex (Hex)) import Language.Java.Classfile.Stage (Stage(Parse, Resolve)) import Data.Kind (Type) +import Pretty.Serialize (ShowPrettySerialize(ShowPrettySerialize), PrettySerialize) -- | 'Stage'-indexed Magic type. The 'Resolve' stage is only a unit type. @@ -23,6 +25,7 @@ data Magic stage where Cafebabe :: Magic Resolve deriving instance Show (Magic stage) +deriving via ShowPrettySerialize (Magic stage) instance PrettySerialize (Magic stage) instance Extractable (Magic Parse) where extract :: Extract (Magic Parse) diff --git a/src/Language/Java/Classfile/Methods.hs b/src/Language/Java/Classfile/Methods.hs index 814b9b6..fe6970f 100644 --- a/src/Language/Java/Classfile/Methods.hs +++ b/src/Language/Java/Classfile/Methods.hs @@ -14,12 +14,13 @@ import Language.Java.Classfile.Extractable (Extractable) import GHC.Generics ( Generically, Generic, Generically(..) ) import Language.Java.Classfile.ConstantPool.References (Utf8Reference) import Language.Java.Classfile.Attributes (Attributes) +import Pretty.Serialize (PrettySerialize) -- | Alias for the methods structure from the constant-pool. newtype Methods = Methods (Array Word16 Method) deriving stock (Show) - deriving newtype Extractable + deriving newtype (Extractable, PrettySerialize) -- | A single method record, contains attributes, name and access flags. @@ -30,7 +31,7 @@ data Method = Method , attributes :: Attributes } deriving stock (Show, Generic) - deriving Extractable via Generically Method + deriving (Extractable, PrettySerialize) via Generically Method -- | Flags for the method, such as abstract, public or static. @@ -47,7 +48,8 @@ data MethodFlag | Abstract | Strict | Synthetic - deriving stock (Show, Eq, Ord, Enum, Bounded) + deriving stock (Show, Eq, Ord, Enum, Bounded, Generic) + deriving PrettySerialize via Generically MethodFlag instance FlagMask MethodFlag where type FlagType MethodFlag = Word16 diff --git a/src/Language/Java/Classfile/Version.hs b/src/Language/Java/Classfile/Version.hs index 4220868..b9cde0f 100644 --- a/src/Language/Java/Classfile/Version.hs +++ b/src/Language/Java/Classfile/Version.hs @@ -7,6 +7,7 @@ module Language.Java.Classfile.Version (Version(..)) where import Data.Word (Word16) import GHC.Generics (Generic, Generically(Generically)) import Language.Java.Classfile.Extractable (Extractable) +import Pretty.Serialize (PrettySerialize) -- | Classfile versions only have two components. The minor component is zero since some java version. @@ -15,7 +16,7 @@ data Version = Version , major :: Word16 } deriving stock (Show, Generic) - deriving Extractable via Generically Version + deriving (Extractable, PrettySerialize) via Generically Version -- >>> import Language.Java.Classfile.Extractable (Extractable(extract)) -- >>> import Language.Java.Classfile.Extract (runExtract, Extract) diff --git a/stack.yaml b/stack.yaml index d2efd23..2a3b9c3 100644 --- a/stack.yaml +++ b/stack.yaml @@ -32,6 +32,7 @@ compiler: ghc-9.12.1 # - wai packages: - . +- 3rdparty/pretty-parse # Dependency packages to be pulled from upstream that are not in the snapshot. # These entries can reference officially published versions as well as # forks / in-progress versions pinned to a git hash. For example: From 500bfa349ea782011b26546d98b1b9888adcb731 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Wed, 20 Aug 2025 19:50:06 +0200 Subject: [PATCH 8/8] fix[PrettySerialize]: Optic changes --- 3rdparty/pretty-parse | 2 +- src/Language/Java/Classfile.hs | 3 ++- src/Language/Java/Classfile/Flags.hs | 8 +++----- 3 files changed, 6 insertions(+), 7 deletions(-) diff --git a/3rdparty/pretty-parse b/3rdparty/pretty-parse index 93473c9..a7bff63 160000 --- a/3rdparty/pretty-parse +++ b/3rdparty/pretty-parse @@ -1 +1 @@ -Subproject commit 93473c9ac69c20053d9fbe1b8a0ee199980cc435 +Subproject commit a7bff630fc3e5e140274fb65d6b88b46e7a086eb diff --git a/src/Language/Java/Classfile.hs b/src/Language/Java/Classfile.hs index ae5b1c1..7f1c727 100644 --- a/src/Language/Java/Classfile.hs +++ b/src/Language/Java/Classfile.hs @@ -11,6 +11,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Language.Java.Classfile (Classfile(..)) where import GHC.Generics (Generic, Generically(Generically)) @@ -59,7 +60,7 @@ data family ClassFlags stage newtype instance ClassFlags Parse = ClassFlags (Flags ClassFlag) deriving stock (Show, Generic) deriving Extractable via Generically (ClassFlags Parse) - deriving PrettySerialize via Generically (ClassFlags Parse) + deriving newtype PrettySerialize data ClassFlag = Public -- ^ may be accessed from outside the package diff --git a/src/Language/Java/Classfile/Flags.hs b/src/Language/Java/Classfile/Flags.hs index c067a82..31c2213 100644 --- a/src/Language/Java/Classfile/Flags.hs +++ b/src/Language/Java/Classfile/Flags.hs @@ -7,9 +7,8 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Language.Java.Classfile.Flags (Flags(..), FlagMask(..), containsFlag) where @@ -24,14 +23,13 @@ import Language.Java.Classfile.Extractable (Extractable (extract)) import Data.Kind (Type) import Control.Arrow ((>>>)) import qualified Data.List as List -import GHC.Generics (Generic, Generically(..)) import Pretty.Serialize (PrettySerialize) -- | Using the 'FlagMask' instance of the type parameter, this will extract all the flags whose mask produced a non-zero value using '.&.' newtype Flags a = Flags (Set a) - deriving (Show, Generic) -deriving via Generically (Flags a) instance (PrettySerialize (Set a)) => PrettySerialize (Flags a) + deriving (Show) + deriving newtype PrettySerialize instance (Extractable (FlagType a), Bounded a, Enum a, Ord a, FlagMask a, Bits (FlagType a), Num (FlagType a)) => Extractable (Flags a) where extract :: Extract (Flags a)