3 files changed, 129 insertions, 0 deletions
diff --git a/hsm-repl/Hsm/Repl.hs b/hsm-repl/Hsm/Repl.hs
new file mode 100644
index 0000000..00012c5
--- /dev/null
+++ b/hsm-repl/Hsm/Repl.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module Hsm.Repl
+  ( Repl
+  , repl
+  , runRepl
+  )
+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 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 String.ANSI (blue)
+import System.Console.Haskeline (defaultSettings, getInputLine, handleInterrupt, withInterrupt)
+import System.Console.Haskeline.IO (InputState, cancelInput, initializeInput, queryInput)
+
+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
+
+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 . blue $
+        symbolVal (Proxy @p)
+    parse string = do
+      logMsg Trace $ "Parsing string: " <> string
+      eitherValue <-
+        unsafeEff_ . runInterpreter $ do
+          setImports $ symbolVals @ms
+          interpret string as
+      case eitherValue of
+        Right value -> do
+          logMsg Trace $ "Parsed value: " <> show value
+          return $ Just value
+        Left (WontCompile errors) -> do
+          forM_ errors $ logMsg Attention . errMsg
+          repl
+        Left err -> do
+          logMsg Attention $ show err
+          repl
+
+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
+  where
+    inputStateAlloc = do
+      logMsg Info "Initializing input"
+      liftIO $ initializeInput defaultSettings
+    inputStateDealloc inputState = do
+      logMsg Info "Cancelling input"
+      liftIO $ cancelInput inputState
diff --git a/hsm-repl/Test/Repl.hs b/hsm-repl/Test/Repl.hs
new file mode 100644
index 0000000..7d1431c
--- /dev/null
+++ b/hsm-repl/Test/Repl.hs
@@ -0,0 +1,8 @@
+import Control.Monad.Loops (whileJust_)
+import Data.Function ((&))
+import Effectful (runEff)
+import Hsm.Log (Severity (Trace), runLog)
+import Hsm.Repl (repl, runRepl)
+
+main :: IO ()
+main = whileJust_ repl return & runRepl @"exec-repl λ " @'["Prelude"] @[Bool] & runLog @"repl" Trace & runEff
diff --git a/hsm-repl/hsm-repl.cabal b/hsm-repl/hsm-repl.cabal
new file mode 100644
index 0000000..5d9a794
--- /dev/null
+++ b/hsm-repl/hsm-repl.cabal
@@ -0,0 +1,44 @@
+cabal-version: 3.8
+author:        Paul Oliver <contact@pauloliver.dev>
+name:          hsm-repl
+version:       0.1.0.0
+
+library
+  build-depends:
+    , base
+    , effectful-core
+    , effectful-plugin
+    , generic-data-functions
+    , haskeline
+    , hint
+    , hsm-log
+    , text-ansi
+
+  default-language: GHC2024
+  exposed-modules:  Hsm.Repl
+  ghc-options:
+    -O2 -Wall -Werror -Wno-star-is-type -Wunused-packages
+    -fplugin=Effectful.Plugin
+
+executable test-repl
+  build-depends:
+    , base
+    , effectful-core
+    , effectful-plugin
+    , generic-data-functions
+    , haskeline
+    , hint
+    , hsm-log
+    , monad-loops
+    , text-ansi
+
+  default-language: GHC2024
+  ghc-options:
+    -O2 -Wall -Werror -Wno-star-is-type -Wunused-packages
+    -fplugin=Effectful.Plugin
+
+  if !arch(x86_64)
+    ghc-options: -optl=-mno-fix-cortex-a53-835769
+
+  main-is:          Test/Repl.hs
+  other-modules:    Hsm.Repl