module Operation where
import Control.Monad.State
import Control.Monad.Error
import Editor
import Engine
import Offset
modified :: Ctx m => Editor m Bool
modified = do
lastw <- gets lastsaved
now <- gets file
return $ maybe True (== now) lastw
resetpending :: Ctx m => Editor m ()
resetpending = setpending Nothing
evalSensible :: Ctx m => Command -> Editor m () -> Editor m ()
evalSensible c action = do
mod <- modified
if mod then
let onunpending = setpending (Just c) >> errorlog (show $ PendingState c)
onpending x = if x == c then action >> resetpending
else onunpending
in gets pending >>= maybe onunpending onpending
else action >> resetpending
checkPendings :: Ctx m => Editor m () -> Editor m ()
checkPendings action = do
pends <- gets pending
action
newpends <- gets pending
when (newpends == pends) resetpending
commandMode :: Ctx m
=> (String -> Either String CompleteCommand)
-> (CompleteCommand -> Editor m ())
-> Editor m ()
commandMode parse eval = let
parseval line = either (throwError . ParserErr )
((history line >>). checkPendings . eval)
(parse line)
prompt = do
p <- gets $ pos . file
pinput $ case p of
Begin -> "0 > "
Line p -> show p ++ " > "
End _ -> "$ > "
in prompt >>= maybe (throwError StopErr) parseval
commandLoop :: Ctx m
=> (String -> Either String CompleteCommand)
-> (CompleteCommand -> Editor m ())
-> Editor m ()
commandLoop parse eval = let
reaction StopErr = errorlog "End" >> return False
reaction (Ahi x) = errorlog ("Unhandled exception: " ++ x) >> return False
reaction BackendErr = errorlog "Buffer index error" >> return True
reaction (ParserErr s) = errorlog ("Parser error: " ++ s) >> return True
reaction err = errorlog ("Evaluation error: " ++ show err) >> return True
in do run <- catchError (commandMode parse eval >> return True) reaction
if run then commandLoop parse eval else return ()
inputMode :: Ctx m => Editor m [String]
inputMode = input >>= maybe (aline "") aline
where aline jl = case jl of
"." -> return []
otherwise -> inputMode >>= return . (jl:)