feat[resolver]: datatype-generic resolving

java-classfile.cabal

@@ -38,6 +38,8 @@ 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:
@@ -50,6 +52,7 @@ library
     , base >=4.7 && <5
     , bytestring
     , containers
+    , mtl
     , pretty-parse
     , text
   default-language: Haskell2010

package.yaml

@@ -39,6 +39,7 @@ library:
   dependencies:
   - array
   - containers
+  - mtl
   - pretty-parse
   - text
 

src/Language/Java/Classfile.hs

@@ -17,6 +17,9 @@ 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)
@@ -24,13 +27,11 @@ 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)
+import Language.Java.Classfile.ConstantPool.References (Class, Utf8)
 import Language.Java.Classfile.Interfaces (Interfaces)
 import Language.Java.Classfile.Fields (Fields)
 import Language.Java.Classfile.Methods (Methods)
-import Language.Java.Classfile.Attributes (Attributes)
+import Language.Java.Classfile.Attributes (Attributes, Attribute)
-import Data.Word (Word16)
-import Pretty.Serialize (PrettySerialize)
 
 
 -- | 'Stage'-indexed classfile. It can represent a class, an interface or a module.
@@ -43,14 +44,14 @@ data Classfile stage = Classfile
   , accessFlags  :: ClassFlags stage
   , this         :: Class stage
   , super        :: Class stage
-  , interfaces   :: Interfaces
+  , interfaces   :: Interfaces stage
-  , fields       :: Fields
+  , fields       :: Fields stage
-  , methods      :: Methods
+  , methods      :: Methods stage
-  , attributes   :: Attributes
+  , attributes   :: Attributes stage
   }
   deriving stock (Generic)
 
-deriving instance (Show (Magic stage), Show (ConstantPool stage), Show (ClassFlags stage), Show (Class stage)) => Show (Classfile stage)
+deriving instance (Show (Attribute stage), Show (Utf8 stage), 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))
 

src/Language/Java/Classfile/Attributes.hs

@@ -3,28 +3,43 @@
 {-# 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 (Utf8Reference)
+import Language.Java.Classfile.ConstantPool.References (Utf8)
 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.
 
-newtype Attributes = Attributes (Array Word16 Attribute)
+type Attributes :: Stage -> Type
-  deriving stock (Show)
+newtype Attributes stage = Attributes (Array Word16 (Attribute stage))
-  deriving newtype (Extractable, PrettySerialize)
+
+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)
 
 -- | Unknown Attribute
 
-data Attribute = Attribute
+type Attribute :: Stage -> Type
-  { name :: Utf8Reference
+data family Attribute stage
+
+data instance Attribute Parse = RawAttribute
+  { name :: Utf8 Parse
   , info :: SizedBytes Word32
   }
   deriving stock (Show, Generic)
-  deriving (Extractable, PrettySerialize) via Generically Attribute
+  deriving (Extractable, PrettySerialize) via Generically (Attribute Parse)

src/Language/Java/Classfile/ConstantPool/Entry.hs

@@ -11,9 +11,10 @@
 {-# 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 (ClassReference, NameAndTypeReference, MethodHandleReferenceKind, OpaqueReference, BootstrapMethodIndex, Utf8Reference)
+import Language.Java.Classfile.ConstantPool.References (Class, NameAndTypeReference, MethodHandleReferenceKind, OpaqueReference, BootstrapMethodIndex, Utf8)
 import Data.Int (Int32, Int64)
 import Data.Word (Word16)
 import Data.Text (Text)
@@ -36,29 +37,29 @@ data Entry
   -- ^ Constant value for ldc
   | Double              (Word8Tag 6  Double)
   -- ^ Constant value for ldc
-  | Class               (Word8Tag 7  Utf8Reference)
+  | Class               (Word8Tag 7  (Utf8 Parse))
   -- ^ Reference to another class: full name
-  | String              (Word8Tag 8  Utf8Reference)
+  | String              (Word8Tag 8  (Utf8 Parse))
   -- ^ Constant value for ldc or ConstantValue attributes.
-  | FieldRef            (Word8Tag 9  (ClassReference, NameAndTypeReference))
+  | FieldRef            (Word8Tag 9  (Class Parse, NameAndTypeReference))
   -- ^ Reference to a field: (containing class, descriptor)
-  | MethodRef           (Word8Tag 10 (ClassReference, NameAndTypeReference))
+  | MethodRef           (Word8Tag 10 (Class Parse, NameAndTypeReference))
   -- ^ Reference to a method: (containing class, descriptor)
-  | InterfaceMethodRef  (Word8Tag 11 (ClassReference, NameAndTypeReference))
+  | InterfaceMethodRef  (Word8Tag 11 (Class Parse, NameAndTypeReference))
   -- ^ Reference to an interface method: (containing class, descriptor)
-  | NameAndType         (Word8Tag 12 (Utf8Reference, Utf8Reference))
+  | NameAndType         (Word8Tag 12 (Utf8 Parse, Utf8 Parse))
   -- ^ Name and Type: (name, type)
   | MethodHandle        (Word8Tag 15 MethodHandleInfo)
   -- ^ Reference to a Method, but more *dynamic*
-  | MethodType          (Word8Tag 16 Utf8Reference)
+  | MethodType          (Word8Tag 16 (Utf8 Parse))
   -- ^ 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 Utf8Reference)
+  | Module              (Word8Tag 19 (Utf8 Parse))
   -- ^ Some module description
-  | Package             (Word8Tag 20 Utf8Reference)
+  | Package             (Word8Tag 20 (Utf8 Parse))
   -- ^ Some package description
   deriving stock (Show, Generic)
   deriving Extractable via Generically Entry

src/Language/Java/Classfile/ConstantPool/References.hs

@@ -8,7 +8,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE DeriveGeneric #-}
-module Language.Java.Classfile.ConstantPool.References (Utf8Reference(..), ClassReference(..), NameAndTypeReference(..), MethodHandleReferenceKind(..), OpaqueReference(..), BootstrapMethodIndex(..), Class) where
+module Language.Java.Classfile.ConstantPool.References (Utf8(..), Class(..), NameAndTypeReference(..), MethodHandleReferenceKind(..), OpaqueReference(..), BootstrapMethodIndex(..), ) where
 import Data.Word (Word16, Word8)
 import Language.Java.Classfile.Extractable (Extractable)
 import Language.Java.Classfile.Extractable.AsTag
@@ -20,23 +20,25 @@ import GHC.Generics (Generically(..), Generic)
 
 -- | Wrapper for constant-pool reference to text.
 
-newtype Utf8Reference = Utf8Reference Word16
+type Utf8 :: Stage -> Type
+data family Utf8 stage
+
+newtype instance Utf8 Parse = Utf8Reference Word16
   deriving stock (Show, Generic)
   deriving newtype Extractable
-  deriving PrettySerialize via Generically Utf8Reference
+  deriving PrettySerialize via Generically (Utf8 Parse)
 
 -- | 'Stage'-indexed type, either a Class or only a t'ClassReference'.
 
 type Class :: Stage -> Type
-type family Class stage where
+data family Class stage
-  Class Parse = ClassReference
 
 -- | Reference to a class in a constant-pool. This will resolve into a class.
 
-newtype ClassReference = ClassReference Word16
+newtype instance Class Parse = ClassReference Word16
   deriving stock (Show, Generic)
   deriving newtype Extractable
-  deriving PrettySerialize via Generically ClassReference
+  deriving PrettySerialize via Generically (Class Parse)
 
 -- | Reference to a class in a constant-pool. This will resolve to Name and Type.
 

src/Language/Java/Classfile/Fields.hs

@@ -6,21 +6,32 @@
 {-# 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 (Utf8Reference)
+import Language.Java.Classfile.ConstantPool.References (Utf8)
 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.
 
-newtype Fields = Fields (Array Word16 Field)
+type Fields :: Stage -> Type
-  deriving stock Show
+newtype Fields stage = Fields (Array Word16 (Field stage))
-  deriving newtype (Extractable, PrettySerialize)
+
+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)
 
 -- | All the access flags a field can have
 
@@ -53,11 +64,15 @@ instance FlagMask FieldFlag where
 
 -- | A singular field of a class.
 
-data Field = Field
+type Field :: Stage -> Type
+data Field stage = Field
   { flags      :: Flags FieldFlag
-  , name       :: Utf8Reference
+  , name       :: Utf8 stage
-  , descriptor :: Utf8Reference
+  , descriptor :: Utf8 stage
-  , attribute  :: Attributes
+  , attribute  :: Attributes stage
   }
-  deriving stock (Show, Generic)
+  deriving stock (Generic)
-  deriving (Extractable, PrettySerialize) via Generically Field
+
+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)

src/Language/Java/Classfile/Interfaces.hs

@@ -2,16 +2,28 @@
 
 {-# 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 (ClassReference)
+import Language.Java.Classfile.ConstantPool.References (Class)
 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.
 
-newtype Interfaces = Interfaces (Array Word16 ClassReference)
+type Interfaces :: Stage -> Type
-  deriving stock (Show, Generic)
+newtype Interfaces stage = Interfaces (Array Word16 (Class stage))
-  deriving (Extractable, PrettySerialize) via Generically Interfaces
+  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)

src/Language/Java/Classfile/Methods.hs

@@ -6,32 +6,46 @@
 {-# 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 (Utf8Reference)
+import Language.Java.Classfile.ConstantPool.References (Utf8)
 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 = Methods (Array Word16 Method)
+newtype Methods stage = Methods (Array Word16 (Method stage))
-  deriving stock (Show)
+
-  deriving newtype (Extractable, PrettySerialize)
+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)
 
 -- | A single method record, contains attributes, name and access flags.
 
-data Method = Method
+type Method :: Stage -> Type
+data Method stage = Method
   { flags       :: Flags MethodFlag
-  , name        :: Utf8Reference
+  , name        :: Utf8 stage
-  , descriptor  :: Utf8Reference
+  , descriptor  :: Utf8 stage
-  , attributes  :: Attributes
+  , attributes  :: Attributes stage
   }
-  deriving stock (Show, Generic)
+  deriving stock (Generic)
-  deriving (Extractable, PrettySerialize) via Generically Method
+
+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)
 
 -- | Flags for the method, such as abstract, public or static.
 

src/Language/Java/Classfile/Resolvable.hs

@@ -0,0 +1,103 @@
+{-# 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 "<unknown field>" $ 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
+

src/Language/Java/Classfile/Resolver.hs

@@ -0,0 +1,59 @@
+{-# 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