fix: redundant imports, exposed internals
This commit is contained in:
parent
fcedb1b057
commit
1b195de90b
2 changed files with 19 additions and 3 deletions
|
@ -17,7 +17,7 @@ module Language.Java.Classfile.Resolvable (Resolver, Resolvable(..), Stageable(.
|
||||||
import Data.Kind (Type)
|
import Data.Kind (Type)
|
||||||
|
|
||||||
import Language.Java.Classfile.Resolver (Resolver, enterDatatype, enterConstructor, enterField)
|
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.Generics (K1 (K1), U1 (U1), (:*:) ((:*:)), (:+:) (..), M1 (M1), Meta(MetaData, MetaCons, MetaSel), Generic)
|
||||||
import GHC.TypeLits (symbolVal, KnownSymbol)
|
import GHC.TypeLits (symbolVal, KnownSymbol)
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
import Data.Proxy (Proxy(Proxy))
|
import Data.Proxy (Proxy(Proxy))
|
||||||
|
|
|
@ -3,6 +3,9 @@
|
||||||
{-# LANGUAGE DeriveFunctor #-}
|
{-# LANGUAGE DeriveFunctor #-}
|
||||||
{-# LANGUAGE InstanceSigs #-}
|
{-# LANGUAGE InstanceSigs #-}
|
||||||
{-# LANGUAGE OverloadedRecordDot #-}
|
{-# LANGUAGE OverloadedRecordDot #-}
|
||||||
|
{-# LANGUAGE NoFieldSelectors #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
-- | Monad for the resolvable computation.
|
-- | Monad for the resolvable computation.
|
||||||
|
|
||||||
module Language.Java.Classfile.Resolver (Resolver, State(..), Reply(..), runResolver, enterDatatype, enterConstructor, enterField) where
|
module Language.Java.Classfile.Resolver (Resolver, State(..), Reply(..), runResolver, enterDatatype, enterConstructor, enterField) where
|
||||||
|
@ -10,6 +13,7 @@ module Language.Java.Classfile.Resolver (Resolver, State(..), Reply(..), runReso
|
||||||
import Language.Java.Classfile.ConstantPool (ConstantPool)
|
import Language.Java.Classfile.ConstantPool (ConstantPool)
|
||||||
import Language.Java.Classfile.Stage ( Stage(Parse) )
|
import Language.Java.Classfile.Stage ( Stage(Parse) )
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
import Control.Monad.Reader (MonadReader (local), ask)
|
||||||
|
|
||||||
-- | Fed to the Resolver Monad
|
-- | Fed to the Resolver Monad
|
||||||
|
|
||||||
|
@ -25,12 +29,15 @@ data Reply a = Reply
|
||||||
}
|
}
|
||||||
deriving stock (Functor)
|
deriving stock (Functor)
|
||||||
|
|
||||||
|
-- | Contains a computation that will resolve to something of type 'a' when supplied with a 'ConstantPool'.
|
||||||
|
|
||||||
newtype Resolver a = Resolver (State -> Reply a)
|
newtype Resolver a = Resolver (State -> Reply a)
|
||||||
deriving stock (Functor)
|
deriving stock (Functor)
|
||||||
|
|
||||||
runResolver :: State -> Resolver a -> Reply a
|
-- | Supply the constant pool needed for the computation.
|
||||||
runResolver state (Resolver computeReply) = computeReply state
|
|
||||||
|
runResolver :: ConstantPool Parse -> Resolver a -> Reply a
|
||||||
|
runResolver pool (Resolver computeReply) = computeReply (State pool)
|
||||||
|
|
||||||
instance Applicative Resolver where
|
instance Applicative Resolver where
|
||||||
pure :: a -> Resolver a
|
pure :: a -> Resolver a
|
||||||
|
@ -53,6 +60,15 @@ instance Monad Resolver where
|
||||||
|
|
||||||
in computeB replyA.nextState
|
in computeB replyA.nextState
|
||||||
|
|
||||||
|
instance MonadReader (ConstantPool Parse) Resolver where
|
||||||
|
ask :: Resolver (ConstantPool Parse)
|
||||||
|
ask = Resolver $ \ input -> Reply input input.pool
|
||||||
|
|
||||||
|
local :: (ConstantPool Parse -> ConstantPool Parse) -> Resolver a -> Resolver a
|
||||||
|
local f (Resolver computeA) = Resolver $ \ input -> let
|
||||||
|
modifiedInput = input { pool = f input.pool }
|
||||||
|
in computeA modifiedInput
|
||||||
|
|
||||||
enterDatatype, enterConstructor, enterField :: Text -> Resolver a -> Resolver a
|
enterDatatype, enterConstructor, enterField :: Text -> Resolver a -> Resolver a
|
||||||
enterDatatype name body = body
|
enterDatatype name body = body
|
||||||
enterConstructor name body = body
|
enterConstructor name body = body
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue