diff --git a/java-classfile.cabal b/java-classfile.cabal index 19c5bdc..20de1a3 100644 --- a/java-classfile.cabal +++ b/java-classfile.cabal @@ -38,8 +38,6 @@ library Language.Java.Classfile.Interfaces Language.Java.Classfile.Magic Language.Java.Classfile.Methods - Language.Java.Classfile.Resolvable - Language.Java.Classfile.Resolver Language.Java.Classfile.Stage Language.Java.Classfile.Version other-modules: @@ -52,7 +50,6 @@ library , base >=4.7 && <5 , bytestring , containers - , mtl , pretty-parse , text default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 1fa0674..022edb1 100644 --- a/package.yaml +++ b/package.yaml @@ -39,7 +39,6 @@ library: dependencies: - array - containers - - mtl - pretty-parse - text diff --git a/src/Language/Java/Classfile.hs b/src/Language/Java/Classfile.hs index 32afd59..7f1c727 100644 --- a/src/Language/Java/Classfile.hs +++ b/src/Language/Java/Classfile.hs @@ -17,9 +17,6 @@ module Language.Java.Classfile (Classfile(..)) where import GHC.Generics (Generic, Generically(Generically)) import Data.Kind (Type) -import Data.Word (Word16) - -import Pretty.Serialize (PrettySerialize) import Language.Java.Classfile.Stage (Stage(Parse)) import Language.Java.Classfile.Version (Version) @@ -27,11 +24,13 @@ import Language.Java.Classfile.Magic (Magic) import Language.Java.Classfile.Extractable (Extractable) import Language.Java.Classfile.ConstantPool (ConstantPool) import Language.Java.Classfile.Flags (Flags, FlagMask (..)) -import Language.Java.Classfile.ConstantPool.References (Class, Utf8) +import Language.Java.Classfile.ConstantPool.References (Class) import Language.Java.Classfile.Interfaces (Interfaces) import Language.Java.Classfile.Fields (Fields) import Language.Java.Classfile.Methods (Methods) -import Language.Java.Classfile.Attributes (Attributes, Attribute) +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. @@ -44,14 +43,14 @@ data Classfile stage = Classfile , accessFlags :: ClassFlags stage , this :: Class stage , super :: Class stage - , interfaces :: Interfaces stage - , fields :: Fields stage - , methods :: Methods stage - , attributes :: Attributes stage + , interfaces :: Interfaces + , fields :: Fields + , methods :: Methods + , attributes :: Attributes } deriving stock (Generic) -deriving instance (Show (Attribute stage), Show (Utf8 stage), Show (Magic stage), Show (ConstantPool stage), Show (ClassFlags stage), Show (Class stage)) => Show (Classfile stage) +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)) diff --git a/src/Language/Java/Classfile/Attributes.hs b/src/Language/Java/Classfile/Attributes.hs index d1c79cb..6d3d586 100644 --- a/src/Language/Java/Classfile/Attributes.hs +++ b/src/Language/Java/Classfile/Attributes.hs @@ -3,43 +3,28 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE StandaloneKindSignatures #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} module Language.Java.Classfile.Attributes (Attributes(..), Attribute(..)) where import Data.Array.IArray (Array) import Data.Word (Word16, Word32) import Language.Java.Classfile.Extractable (Extractable) -import Language.Java.Classfile.ConstantPool.References (Utf8) +import Language.Java.Classfile.ConstantPool.References (Utf8Reference) import Language.Java.Classfile.Extractable.SizedBytes (SizedBytes) import GHC.Generics ( Generic, Generically(..) ) import Pretty.Serialize (PrettySerialize) -import Language.Java.Classfile.Stage (Stage(Parse)) -import Data.Kind (Type) -import Data.Typeable (Typeable) -- | Generic Attribute array used everywhere. -- -- Will not respect Attribute location restrictions, does not attempt to parse anything specific. -type Attributes :: Stage -> Type -newtype Attributes stage = Attributes (Array Word16 (Attribute stage)) - -deriving stock instance Show (Attribute stage) => Show (Attributes stage) -deriving newtype instance (Extractable (Attribute stage), Typeable stage) => Extractable (Attributes stage) -deriving newtype instance (PrettySerialize (Attribute stage), Typeable stage) => PrettySerialize (Attributes stage) +newtype Attributes = Attributes (Array Word16 Attribute) + deriving stock (Show) + deriving newtype (Extractable, PrettySerialize) -- | Unknown Attribute -type Attribute :: Stage -> Type -data family Attribute stage - -data instance Attribute Parse = RawAttribute - { name :: Utf8 Parse +data Attribute = Attribute + { name :: Utf8Reference , info :: SizedBytes Word32 } deriving stock (Show, Generic) - deriving (Extractable, PrettySerialize) via Generically (Attribute Parse) + deriving (Extractable, PrettySerialize) via Generically Attribute diff --git a/src/Language/Java/Classfile/ConstantPool/Entry.hs b/src/Language/Java/Classfile/ConstantPool/Entry.hs index 3501e93..8c6e07b 100644 --- a/src/Language/Java/Classfile/ConstantPool/Entry.hs +++ b/src/Language/Java/Classfile/ConstantPool/Entry.hs @@ -11,10 +11,9 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Language.Java.Classfile.ConstantPool.Entry (Entry(..), StorageCount(..), storageCount, MethodHandleInfo(..)) where import GHC.Generics (Generic, Generically(..)) -import Language.Java.Classfile.Stage (Stage(Parse)) import Language.Java.Classfile.Extractable (Extractable (extract)) import Language.Java.Classfile.Extractable.WithTag (Word8Tag) -import Language.Java.Classfile.ConstantPool.References (Class, NameAndTypeReference, MethodHandleReferenceKind, OpaqueReference, BootstrapMethodIndex, Utf8) +import Language.Java.Classfile.ConstantPool.References (ClassReference, NameAndTypeReference, MethodHandleReferenceKind, OpaqueReference, BootstrapMethodIndex, Utf8Reference) import Data.Int (Int32, Int64) import Data.Word (Word16) import Data.Text (Text) @@ -37,29 +36,29 @@ data Entry -- ^ Constant value for ldc | Double (Word8Tag 6 Double) -- ^ Constant value for ldc - | Class (Word8Tag 7 (Utf8 Parse)) + | Class (Word8Tag 7 Utf8Reference) -- ^ Reference to another class: full name - | String (Word8Tag 8 (Utf8 Parse)) + | String (Word8Tag 8 Utf8Reference) -- ^ Constant value for ldc or ConstantValue attributes. - | FieldRef (Word8Tag 9 (Class Parse, NameAndTypeReference)) + | FieldRef (Word8Tag 9 (ClassReference, NameAndTypeReference)) -- ^ Reference to a field: (containing class, descriptor) - | MethodRef (Word8Tag 10 (Class Parse, NameAndTypeReference)) + | MethodRef (Word8Tag 10 (ClassReference, NameAndTypeReference)) -- ^ Reference to a method: (containing class, descriptor) - | InterfaceMethodRef (Word8Tag 11 (Class Parse, NameAndTypeReference)) + | InterfaceMethodRef (Word8Tag 11 (ClassReference, NameAndTypeReference)) -- ^ Reference to an interface method: (containing class, descriptor) - | NameAndType (Word8Tag 12 (Utf8 Parse, Utf8 Parse)) + | NameAndType (Word8Tag 12 (Utf8Reference, Utf8Reference)) -- ^ Name and Type: (name, type) | MethodHandle (Word8Tag 15 MethodHandleInfo) -- ^ Reference to a Method, but more *dynamic* - | MethodType (Word8Tag 16 (Utf8 Parse)) + | MethodType (Word8Tag 16 Utf8Reference) -- ^ Descriptor of a Method | Dynamic (Word8Tag 17 (BootstrapMethodIndex, NameAndTypeReference)) -- ^ Unspeakable horrors: index into the bootstrapmethod attribute array, NameAndType must refer to a field | InvokeDynamic (Word8Tag 18 (BootstrapMethodIndex, NameAndTypeReference)) -- ^ Unspeakable horrors: index into the bootstrapmethod attribute array, NameAndType must refer to a method - | Module (Word8Tag 19 (Utf8 Parse)) + | Module (Word8Tag 19 Utf8Reference) -- ^ Some module description - | Package (Word8Tag 20 (Utf8 Parse)) + | Package (Word8Tag 20 Utf8Reference) -- ^ Some package description deriving stock (Show, Generic) deriving Extractable via Generically Entry diff --git a/src/Language/Java/Classfile/ConstantPool/References.hs b/src/Language/Java/Classfile/ConstantPool/References.hs index 63d853b..10829b5 100644 --- a/src/Language/Java/Classfile/ConstantPool/References.hs +++ b/src/Language/Java/Classfile/ConstantPool/References.hs @@ -8,7 +8,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE DeriveGeneric #-} -module Language.Java.Classfile.ConstantPool.References (Utf8(..), Class(..), NameAndTypeReference(..), MethodHandleReferenceKind(..), OpaqueReference(..), BootstrapMethodIndex(..), ) where +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) import Language.Java.Classfile.Extractable.AsTag @@ -20,25 +20,23 @@ import GHC.Generics (Generically(..), Generic) -- | Wrapper for constant-pool reference to text. -type Utf8 :: Stage -> Type -data family Utf8 stage - -newtype instance Utf8 Parse = Utf8Reference Word16 +newtype Utf8Reference = Utf8Reference Word16 deriving stock (Show, Generic) deriving newtype Extractable - deriving PrettySerialize via Generically (Utf8 Parse) + deriving PrettySerialize via Generically Utf8Reference -- | 'Stage'-indexed type, either a Class or only a t'ClassReference'. type Class :: Stage -> Type -data family Class stage +type family Class stage where + Class Parse = ClassReference -- | Reference to a class in a constant-pool. This will resolve into a class. -newtype instance Class Parse = ClassReference Word16 +newtype ClassReference = ClassReference Word16 deriving stock (Show, Generic) deriving newtype Extractable - deriving PrettySerialize via Generically (Class Parse) + deriving PrettySerialize via Generically ClassReference -- | Reference to a class in a constant-pool. This will resolve to Name and Type. diff --git a/src/Language/Java/Classfile/Fields.hs b/src/Language/Java/Classfile/Fields.hs index 3d6f710..79af340 100644 --- a/src/Language/Java/Classfile/Fields.hs +++ b/src/Language/Java/Classfile/Fields.hs @@ -6,32 +6,21 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE StandaloneKindSignatures #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} module Language.Java.Classfile.Fields (Fields(..)) where import Data.Array.IArray (Array) import Data.Word (Word16) import Language.Java.Classfile.Extractable (Extractable) import GHC.Generics ( Generically, Generic, Generically(..) ) import Language.Java.Classfile.Flags (Flags, FlagMask (..)) -import Language.Java.Classfile.ConstantPool.References (Utf8) +import Language.Java.Classfile.ConstantPool.References (Utf8Reference) import Language.Java.Classfile.Attributes (Attributes) import Pretty.Serialize (PrettySerialize) -import Language.Java.Classfile.Stage (Stage) -import Data.Kind (Type) -import Data.Typeable (Typeable) -- | Word16-Array of Fields. -type Fields :: Stage -> Type -newtype Fields stage = Fields (Array Word16 (Field stage)) - -deriving stock instance (Show (Field stage)) => Show (Fields stage) -deriving newtype instance (Typeable stage, Extractable (Utf8 stage), Extractable (Attributes stage)) => Extractable (Fields stage) -deriving newtype instance (Typeable stage, PrettySerialize (Utf8 stage), PrettySerialize (Attributes stage)) => PrettySerialize (Fields stage) +newtype Fields = Fields (Array Word16 Field) + deriving stock Show + deriving newtype (Extractable, PrettySerialize) -- | All the access flags a field can have @@ -64,15 +53,11 @@ instance FlagMask FieldFlag where -- | A singular field of a class. -type Field :: Stage -> Type -data Field stage = Field +data Field = Field { flags :: Flags FieldFlag - , name :: Utf8 stage - , descriptor :: Utf8 stage - , attribute :: Attributes stage + , name :: Utf8Reference + , descriptor :: Utf8Reference + , attribute :: Attributes } - deriving stock (Generic) - -deriving stock instance (Show (Utf8 stage), Show (Attributes stage)) => Show (Field stage) -deriving via Generically (Field stage) instance (Extractable (Utf8 stage), Extractable (Attributes stage)) => Extractable (Field stage) -deriving via Generically (Field stage) instance (PrettySerialize (Utf8 stage), PrettySerialize (Attributes stage)) => PrettySerialize (Field stage) + deriving stock (Show, Generic) + deriving (Extractable, PrettySerialize) via Generically Field diff --git a/src/Language/Java/Classfile/Interfaces.hs b/src/Language/Java/Classfile/Interfaces.hs index e545bbe..f1af737 100644 --- a/src/Language/Java/Classfile/Interfaces.hs +++ b/src/Language/Java/Classfile/Interfaces.hs @@ -2,28 +2,16 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE StandaloneKindSignatures #-} -{-# LANGUAGE DataKinds #-} module Language.Java.Classfile.Interfaces (Interfaces(..)) where import Data.Array.IArray (Array) import Data.Word (Word16) -import Language.Java.Classfile.ConstantPool.References (Class) +import Language.Java.Classfile.ConstantPool.References (ClassReference) import Language.Java.Classfile.Extractable (Extractable) import GHC.Generics ( Generic, Generically, Generically(..) ) import Pretty.Serialize (PrettySerialize) -import Language.Java.Classfile.Stage (Stage) -import Data.Kind (Type) -import Data.Typeable (Typeable) -- | A list of classes something implements. -type Interfaces :: Stage -> Type -newtype Interfaces stage = Interfaces (Array Word16 (Class stage)) - deriving stock (Generic) - -deriving stock instance (Show (Class stage)) => Show (Interfaces stage) -deriving via Generically (Interfaces stage) instance (Extractable (Class stage), Typeable stage) => Extractable (Interfaces stage) -deriving via Generically (Interfaces stage) instance (PrettySerialize (Class stage), Typeable stage) => PrettySerialize (Interfaces stage) +newtype Interfaces = Interfaces (Array Word16 ClassReference) + deriving stock (Show, Generic) + deriving (Extractable, PrettySerialize) via Generically Interfaces diff --git a/src/Language/Java/Classfile/Methods.hs b/src/Language/Java/Classfile/Methods.hs index 2bae462..fe6970f 100644 --- a/src/Language/Java/Classfile/Methods.hs +++ b/src/Language/Java/Classfile/Methods.hs @@ -6,46 +6,32 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE StandaloneKindSignatures #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} module Language.Java.Classfile.Methods (Methods(..), Method(..), MethodFlag(..)) where import Data.Array.IArray (Array) import Data.Word (Word16) import Language.Java.Classfile.Flags (Flags, FlagMask (..)) import Language.Java.Classfile.Extractable (Extractable) import GHC.Generics ( Generically, Generic, Generically(..) ) -import Language.Java.Classfile.ConstantPool.References (Utf8) +import Language.Java.Classfile.ConstantPool.References (Utf8Reference) import Language.Java.Classfile.Attributes (Attributes) import Pretty.Serialize (PrettySerialize) -import Language.Java.Classfile.Stage (Stage) -import Data.Kind (Type) -import Data.Typeable (Typeable) -- | Alias for the methods structure from the constant-pool. -newtype Methods stage = Methods (Array Word16 (Method stage)) - -deriving stock instance (Show (Utf8 stage), Show (Attributes stage)) => Show (Methods stage) -deriving newtype instance (Typeable stage, Extractable (Utf8 stage), Extractable (Attributes stage)) => Extractable (Methods stage) -deriving newtype instance (Typeable stage, PrettySerialize (Utf8 stage), PrettySerialize (Attributes stage)) => PrettySerialize (Methods stage) +newtype Methods = Methods (Array Word16 Method) + deriving stock (Show) + deriving newtype (Extractable, PrettySerialize) -- | A single method record, contains attributes, name and access flags. -type Method :: Stage -> Type -data Method stage = Method +data Method = Method { flags :: Flags MethodFlag - , name :: Utf8 stage - , descriptor :: Utf8 stage - , attributes :: Attributes stage + , name :: Utf8Reference + , descriptor :: Utf8Reference + , attributes :: Attributes } - deriving stock (Generic) - -deriving stock instance (Show (Utf8 stage), Show (Attributes stage)) => Show (Method stage) -deriving via Generically (Method stage) instance (Extractable (Utf8 stage), Extractable (Attributes stage)) => Extractable (Method stage) -deriving via Generically (Method stage) instance (PrettySerialize (Utf8 stage), PrettySerialize (Attributes stage)) => PrettySerialize (Method stage) + deriving stock (Show, Generic) + deriving (Extractable, PrettySerialize) via Generically Method -- | Flags for the method, such as abstract, public or static. diff --git a/src/Language/Java/Classfile/Resolvable.hs b/src/Language/Java/Classfile/Resolvable.hs deleted file mode 100644 index e6eba2a..0000000 --- a/src/Language/Java/Classfile/Resolvable.hs +++ /dev/null @@ -1,103 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneKindSignatures #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} --- | Change a datatype from the parsed representation to the Resolved representation. - -module Language.Java.Classfile.Resolvable (Resolver, Resolvable(..), Stageable(..)) where - -import Data.Kind (Type) - -import Language.Java.Classfile.Resolver (Resolver, enterDatatype, enterConstructor, enterField) -import GHC.Generics (K1 (K1), U1 (U1), (:*:) ((:*:)), (:+:) (..), M1 (M1), Meta(MetaData, MetaCons, MetaSel), Generic, Generically (Generically)) -import GHC.TypeLits (symbolVal, KnownSymbol) -import qualified Data.Text as Text -import Data.Proxy (Proxy(Proxy)) -import qualified GHC.Generics as Generics -import Language.Java.Classfile.Stage (Stage(Parse, Resolve)) - -class GenericResolvable a where - type GenericResolved a :: Type -> Type - genericResolve :: a i -> Resolver (GenericResolved a i) - -instance (Resolvable c) => GenericResolvable (K1 i c) where - type GenericResolved (K1 i c) = K1 i (Resolved c) - genericResolve :: K1 i c x -> Resolver (GenericResolved (K1 i c) x) - genericResolve (K1 x)= K1 <$> resolve x - -instance GenericResolvable U1 where - type GenericResolved U1 = U1 - genericResolve :: U1 i -> Resolver (GenericResolved U1 x) - genericResolve U1 = pure U1 - -instance (GenericResolvable l, GenericResolvable r) => GenericResolvable (l :*: r) where - type GenericResolved (l :*: r) = (GenericResolved l :*: GenericResolved r) - genericResolve :: (:*:) l r x -> Resolver (GenericResolved ((:*:) l r) x) - genericResolve (l :*: r) = do - resolvedL <- genericResolve l - resolvedR <- genericResolve r - pure $ resolvedL :*: resolvedR - -instance (GenericResolvable l, GenericResolvable r) => GenericResolvable (l :+: r) where - type GenericResolved (l :+: r) = (GenericResolved l :+: GenericResolved r) - - genericResolve :: (:+:) l r i -> Resolver (GenericResolved (l :+: r) i) - genericResolve = \case - L1 left -> L1 <$> genericResolve left - R1 right -> R1 <$> genericResolve right - --- data type meta information -instance (KnownSymbol name, GenericResolvable a) => GenericResolvable (M1 tag (MetaData name module_ package isNewtype) a) where - type GenericResolved (M1 tag (MetaData name module_ package isNewtype) a) = (M1 tag (MetaData name module_ package isNewtype) (GenericResolved a)) - - genericResolve :: M1 tag (MetaData name module_ package isNewtype) a i -> Resolver (GenericResolved (M1 tag (MetaData name module_ package isNewtype) a) i) - genericResolve (M1 x) = enterDatatype typeName $ M1 <$> genericResolve x - where - typeName = Text.pack . symbolVal $ Proxy @name - --- data constructor meta information -instance (KnownSymbol name, GenericResolvable a) => GenericResolvable (M1 tag (MetaCons name fixity isRecord) a) where - type GenericResolved (M1 tag (MetaCons name fixity isRecord) a) = (M1 tag (MetaCons name fixity isRecord) (GenericResolved a)) - - genericResolve :: M1 tag (MetaCons name fixity isRecord) a i -> Resolver (GenericResolved (M1 tag (MetaCons name fixity isRecord) a) i) - genericResolve (M1 x) = enterConstructor constructorName $ M1 <$> genericResolve x - where - constructorName = Text.pack . symbolVal $ Proxy @name - --- field meta information -instance (KnownSymbol name, GenericResolvable a) => GenericResolvable (M1 tag (MetaSel (Just name) isUnpacked isStrictSource isStrictCompiler) a) where - type GenericResolved (M1 tag (MetaSel (Just name) isUnpacked isStrictSource isStrictCompiler) a) = (M1 tag (MetaSel (Just name) isUnpacked isStrictSource isStrictCompiler) (GenericResolved a)) - genericResolve :: M1 tag (MetaSel (Just name) isUnpacked isStrictSource isStrictCompiler) a i -> Resolver (GenericResolved (M1 tag (MetaSel (Just name) isUnpacked isStrictSource isStrictCompiler) a) i) - genericResolve (M1 x) = enterField fieldName $ M1 <$> genericResolve x - where - fieldName = Text.pack . symbolVal $ Proxy @name - -instance (GenericResolvable a) => GenericResolvable (M1 tag (MetaSel Nothing isUnpacked isStrictSource isStrictCompiler) a) where - type GenericResolved (M1 tag (MetaSel Nothing isUnpacked isStrictSource isStrictCompiler) a) = (M1 tag (MetaSel Nothing isUnpacked isStrictSource isStrictCompiler) (GenericResolved a)) - genericResolve :: M1 tag (MetaSel Nothing isUnpacked isStrictSource isStrictCompiler) a i -> Resolver (GenericResolved (M1 tag (MetaSel Nothing isUnpacked isStrictSource isStrictCompiler) a) i) - genericResolve (M1 x) = enterField "" $ M1 <$> genericResolve x - - -class Resolvable a where - type Resolved a :: Type - resolve :: a -> Resolver (Resolved a) - - -type Stageable :: (Stage -> Type) -> Stage -> Type -newtype Stageable a stage = Stageable (a stage) - -instance (Generic (a Parse), Generic (a Resolve), GenericResolvable (Generics.Rep (a Parse)), GenericResolved (Generics.Rep (a Parse)) ~ Generics.Rep (a Resolve)) => Resolvable (Stageable a Parse) where - type Resolved (Stageable a Parse) = Stageable a Resolve - resolve :: Stageable a Parse -> Resolver (Resolved (Stageable a Parse)) - resolve (Stageable x) = do - resolvedRep <- genericResolve $ Generics.from x - pure . Stageable $ Generics.to resolvedRep - diff --git a/src/Language/Java/Classfile/Resolver.hs b/src/Language/Java/Classfile/Resolver.hs deleted file mode 100644 index d1698c9..0000000 --- a/src/Language/Java/Classfile/Resolver.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE OverloadedRecordDot #-} --- | Monad for the resolvable computation. - -module Language.Java.Classfile.Resolver (Resolver, State(..), Reply(..), runResolver, enterDatatype, enterConstructor, enterField) where - -import Language.Java.Classfile.ConstantPool (ConstantPool) -import Language.Java.Classfile.Stage ( Stage(Parse) ) -import Data.Text (Text) - --- | Fed to the Resolver Monad - -newtype State = State - { pool :: ConstantPool Parse - } - --- | Produced by the resolver monad - -data Reply a = Reply - { nextState :: State - , result :: a - } - deriving stock (Functor) - - -newtype Resolver a = Resolver (State -> Reply a) - deriving stock (Functor) - -runResolver :: State -> Resolver a -> Reply a -runResolver state (Resolver computeReply) = computeReply state - -instance Applicative Resolver where - pure :: a -> Resolver a - pure = Resolver . flip Reply - - (<*>) :: Resolver (a -> b) -> Resolver a -> Resolver b - (<*>) (Resolver computeF) (Resolver computeA) = Resolver $ \ input -> let - - replyF = computeF input - replyA = computeA replyF.nextState - - in Reply replyA.nextState (replyF.result replyA.result) - -instance Monad Resolver where - (>>=) :: Resolver a -> (a -> Resolver b) -> Resolver b - (>>=) (Resolver computeA) f = Resolver $ \ input -> let - - replyA = computeA input - (Resolver computeB) = f replyA.result - - in computeB replyA.nextState - -enterDatatype, enterConstructor, enterField :: Text -> Resolver a -> Resolver a -enterDatatype name body = body -enterConstructor name body = body -enterField name body = body