Hedi-0.1: Operation.hs

-- | Functions for read-eval-do managing
module Operation where

import Control.Monad.State
import Control.Monad.Error

import Editor
import Engine
import Offset

-- | a real check for file modification
modified :: Ctx m w =>  Editor m w Bool
modified = do
	lastw <- gets lastsaved
	now   <- gets file
	return $ maybe True (== now) lastw

resetpending	:: Ctx m w =>  Editor m w ()
resetpending 	= setpending Nothing

-- | a wrapper for commands evaluation which can discard changes
evalSensible :: Ctx m w => Command ->  Editor m w  () -> Editor m w ()
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 

-- | a wrapper for commands evaluation which cannot discard changes
checkPendings :: Ctx m w => Editor m w () -> Editor m w ()
checkPendings action = do
	pends <- gets pending
	action 
	newpends <- gets pending 
	when  (newpends == pends) resetpending


-- | a step in main mode for the editor
commandMode 	:: Ctx m w  	
	=> (String -> Either String CompleteCommand)	-- ^ the parser for the command on the line
	-> (CompleteCommand -> Editor m w ())		-- ^ the evaluator for the parsed command
	-> Editor m w ()				-- ^ updated beast
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

-- | looping in main mode with error log on output
commandLoop :: Ctx m w 
	=> (String -> Either String CompleteCommand)	-- ^ the parser for the command on the line
	-> (CompleteCommand -> Editor m w ())		-- ^ the evaluator for the parsed command
	-> Editor m w ()				-- ^ updated beast

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 ()

-- | the secondary mode for the editor where lines are inserted as input. It returns the lines.Use CTRL-D to exit 
inputMode	::  Ctx m w 	=> Editor m w [String] 
inputMode	= input >>= maybe (aline "") aline
	where aline jl = case jl of
		"." 		-> return []
		otherwise 	-> inputMode >>= return . (jl:)