diff options
Diffstat (limited to 'hsm-repl/Hsm/Repl.hs')
| -rw-r--r-- | hsm-repl/Hsm/Repl.hs | 38 |
1 files changed, 25 insertions, 13 deletions
diff --git a/hsm-repl/Hsm/Repl.hs b/hsm-repl/Hsm/Repl.hs index dacc76a..00012c5 100644 --- a/hsm-repl/Hsm/Repl.hs +++ b/hsm-repl/Hsm/Repl.hs @@ -4,17 +4,26 @@ module Hsm.Repl ( Repl , repl , runRepl - ) where + ) +where import Control.Monad (forM_) -import Data.Typeable (Proxy(Proxy), Typeable, typeRep) -import Effectful (Dispatch(Static), DispatchOf, Eff, IOE, (:>), liftIO) -import Effectful.Dispatch.Static (SideEffects(WithSideEffects), StaticRep, evalStaticRep, getStaticRep, unsafeEff_) +import Data.Typeable (Proxy (Proxy), Typeable, typeRep) +import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, liftIO, (:>)) +import Effectful.Dispatch.Static (SideEffects (WithSideEffects), StaticRep, evalStaticRep, getStaticRep, unsafeEff_) import Effectful.Exception (bracket) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Generic.Data.Function.Common.Generic.Meta (KnownSymbols, symbolVals) -import Hsm.Log (Log, Severity(Attention, Info, Trace), logMsg) -import Language.Haskell.Interpreter (GhcError(errMsg), InterpreterError(WontCompile), as, interpret, runInterpreter, setImports) +import Hsm.Log (Log, Severity (Attention, Info, Trace), logMsg) +import Language.Haskell.Interpreter + ( GhcError (errMsg) + , InterpreterError (WontCompile) + , as + , interpret + , runInterpreter + , setImports + ) +import String.ANSI (blue) import System.Console.Haskeline (defaultSettings, getInputLine, handleInterrupt, withInterrupt) import System.Console.Haskeline.IO (InputState, cancelInput, initializeInput, queryInput) @@ -22,18 +31,20 @@ data Repl (p :: Symbol) (ms :: [Symbol]) (t :: *) (a :: * -> *) (b :: *) type instance DispatchOf (Repl p ms t) = Static WithSideEffects -newtype instance StaticRep (Repl p ms t) = - Repl InputState +newtype instance StaticRep (Repl p ms t) + = Repl InputState -repl :: - forall p ms t es. (KnownSymbol p, KnownSymbols ms, Log "repl" :> es, Repl p ms t :> es, Show t, Typeable t) +repl + :: forall p ms t es + . (KnownSymbol p, KnownSymbols ms, Log "repl" :> es, Repl p ms t :> es, Show t, Typeable t) => Eff es (Maybe t) repl = query >>= maybe (return Nothing) parse where query = do Repl inputState <- getStaticRep logMsg Trace $ "Expecting a value of type: " <> show (typeRep $ Proxy @t) - unsafeEff_ . queryInput inputState . handleInterrupt (return Nothing) . withInterrupt . getInputLine $ symbolVal (Proxy @p) + unsafeEff_ . queryInput inputState . handleInterrupt (return Nothing) . withInterrupt . getInputLine . blue $ + symbolVal (Proxy @p) parse string = do logMsg Trace $ "Parsing string: " <> string eitherValue <- @@ -51,8 +62,9 @@ repl = query >>= maybe (return Nothing) parse logMsg Attention $ show err repl -runRepl :: - forall p ms t es a. (IOE :> es, Log "repl" :> es) +runRepl + :: forall p ms t es a + . (IOE :> es, Log "repl" :> es) => Eff (Repl p ms t : es) a -> Eff es a runRepl action = bracket inputStateAlloc inputStateDealloc $ \inputState -> evalStaticRep (Repl inputState) action |