summaryrefslogtreecommitdiff
path: root/app/Frontend.hs
diff options
context:
space:
mode:
Diffstat (limited to 'app/Frontend.hs')
-rw-r--r--app/Frontend.hs44
1 files changed, 16 insertions, 28 deletions
diff --git a/app/Frontend.hs b/app/Frontend.hs
index 990e79d..77706d8 100644
--- a/app/Frontend.hs
+++ b/app/Frontend.hs
@@ -2,15 +2,16 @@ module Frontend where
import Builtins
import Code (Interp(..))
+import CodeLens
import Control.Monad (when)
-import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (except, runExceptT)
-import Control.Monad.Trans.State.Lazy (evalStateT, gets, modify)
+import Control.Monad.Trans.State.Lazy (evalStateT)
import qualified Data.Map as M
import Env (PrlgEnv)
import qualified IR
import qualified Interpreter as I
+import Lens.Family2.State
import Load
( compile
, intern
@@ -20,19 +21,6 @@ import Load
, shunt
)
import System.Console.Haskeline
-import qualified Text.Pretty.Simple as Ppr
-
-ppr :: Show a => a -> PrlgEnv ()
-ppr x =
- liftIO $
- Ppr.pPrintOpt
- Ppr.CheckColorTty
- Ppr.defaultOutputOptionsDarkBg
- { Ppr.outputOptionsCompactParens = True
- , Ppr.outputOptionsIndentAmount = 2
- , Ppr.outputOptionsPageWidth = 80
- }
- x
-- the signature of this is too ugly to include here
handleError m = do
@@ -40,8 +28,8 @@ handleError m = do
case res of
Left err -> do
lift $ outputStrLn err
- modify $ \s -> s {cmdq = []}
- _ -> pure ()
+ cmdq .= []
+ _ -> (pure () :: PrlgEnv ()) --prevents ambiguity
processCmd precompileHook ast' = do
ast <- shunt ast'
@@ -55,7 +43,7 @@ interpreterStart = do
interpreterLoop :: Bool -> PrlgEnv ()
interpreterLoop queryMode = do
- q <- gets cmdq
+ q <- use cmdq
case q of
[] -> do
minput <-
@@ -71,7 +59,7 @@ interpreterLoop queryMode = do
handleError $ processInput "<user input>" queryMode input
interpreterLoop queryMode
((mode, ast):asts) -> do
- modify $ \s -> s {cmdq = asts}
+ cmdq .= asts
handleError $ do
resOK <-
processCmd
@@ -79,7 +67,7 @@ interpreterLoop queryMode = do
then queryExpansion
else loadExpansion)
ast
- finished <- lift $ gets (null . cmdq)
+ finished <- lift $ cmdq `uses` null
when finished . lift . lift . outputStrLn $
case (resOK, queryMode) of
(True, True) -> "yes."
@@ -93,12 +81,12 @@ interpreter =
evalStateT
interpreterStart
(Interp
- { defs = M.empty
- , cur = error "no cur"
- , cho = []
- , ops = []
- , opstash = []
- , macrostash = []
- , strtable = IR.emptystrtable
- , cmdq = []
+ { _defs = M.empty
+ , _cur = error "no cur"
+ , _cho = []
+ , _ops = []
+ , _opstash = []
+ , _macrostash = []
+ , _strtable = IR.emptystrtable
+ , _cmdq = []
})