-- | The logic of each of the available commands module Eval where import System.IO import Control.Monad.Trans import Control.Monad.Reader import Control.Monad.State import Control.Monad.Error import Editor import Operation import Offset import Undo import Helper import Engine -- | every command is run with eval. See 'Editor.Command' datatype for docs eval :: Ctx m => CompleteCommand -- ^ the command to match for execution -> Editor m () -- ^ monading .. eval (CC Append (ORO o)) = inputMode >>= editOffset o . add eval (CC Insert (ORO o)) = inputMode >>= editOffset o . ins eval (CC Delete (ORO o)) = editOffset o del eval (CC Delete (ORR r)) = editRange r deln eval (CC Change (ORO o)) = do w <- jumpE o (l,u) <- backend $ line w >>= \l -> del w >>= \u -> return (l,u) history l >> inputMode >>= backend . flip ins u >>= putfile eval (CC Change (ORR r)) = do (n,w) <- rangeResolve r u <- backend $ deln n w inputMode >>= backend . flip ins u >>= putfile eval (CC Print (ORO o)) = doOffset o output line eval (CC Print (ORR r)) = doRange r (mapM_ output) linen eval (CC NoCommand (ORO o)) = jumpE o >>= \w -> backend (line w) >>= output >> putfile w eval (CC NoCommand ORN) = jumpE (Next 1) >>= \w -> backend (line w) >>= output >> putfile w eval (CC NoCommand (ORR (Range o1 o2))) = jumpE o2 >>= putfile eval (CC c@(Edit e) _) = evalSensible c $ liftSio (runErrorT $ readfileSio e) >>= either (throwError . FileReadErr) (putfile . listIn . lines) >> setfilename (Just e) >> setlastsaved eval (CC Write _) = getname (throwError FileNameMissing) >>= write >> unsetlastsaved eval (CC (WriteNew nname) _) = getname (return nname) >>= \name -> write nname >> setfilename (Just name) >> setlastsaved eval (CC GetFilename _) = getname (throwError FileNameMissing ) >>= output eval (CC c@(SetFilename s) _) = gets filename >>= flip (maybe id (const $ evalSensible c)) (setfilename (Just s) >> unsetlastsaved) eval (CC c@(EditExternal s) _) = evalSensible c $ liftSio (runErrorT $ externalSio s) >>= either (throwError . ExternalCommandErr) (putfile . listIn . lines) >> unsetlastsaved eval (CC UndoChange _) = liftStatoE undo >>= bool (return ()) (throwError NoMoreUndo) eval (CC RedoChange _) = liftStatoE redo >>= bool (return ()) (throwError NoMoreRedo) eval (CC HelpList _) = liftSio (runErrorT $ readfileSio "command.help") >>= either (throwError . FileReadErr) (return . listOfCommands) >>= either (throwError . CommandHelpParseErr) (maybe (throwError $ Ahi "Boh") output) eval (CC (HelpTopic t) _) = liftSio (runErrorT $ readfileSio "command.help") >>= either (throwError . FileReadErr) (return . helpCommand t) >>= either (throwError . CommandHelpParseErr) (maybe (throwError CommandHelpMissing) output) bool x y b = if b then x else y -- | throw a 'writerSio' error to Editor writefail :: Ctx m => Either String () -> Editor m () writefail = either (throwError . FileWriteErr) return -- | dump the engine content to a file via writefileSio write :: Ctx m => String -- ^ filename -> Editor m () -- ^ monading write name = do contents <- unlines `fmap` through listOut (liftSio . runErrorT) (writefileSio name contents) >>= writefail setlastsaved -- | get the filename defaulting to some other action to produce one getname :: Ctx m => Editor m String -> Editor m String getname defaul = gets filename >>= maybe defaul return