[added src anchored html colourised paolo.veronelli@gmail.com**20080209175443] { addfile ./docs/src/Buffer.html hunk ./docs/src/Buffer.html 1 + + + + +Haskell Code by HsColour + + + +
-- | An Editor backend implementation, made of the instance of Engine of InsideAppend.
+module Buffer (InsideAppend (..))
+where
+
+import Data.Maybe
+import Engine
+import Test.QuickCheck
+
+-- |See the "Engine" class docs 
+data InsideAppend 
+	-- | the cursor when its pointing to a real line (eg line function doesn't fail)
+	= Inside {
+		left 	:: [String], 	-- ^ lines before the cursor (reversed order)
+		cursor 	::String , 	-- ^ addressed line
+		right 	:: [String]	-- ^ lines after the cursor
+		}
+	-- | the cursor is pointing either to insert at the front of the file or  
+	-- append at the end of the file.
+	| Append  
+		{ 
+		elems :: Either [String] [String] -- ^ Left lines is in append mode, Right is in insert at front mode.
+		}
+	deriving (Show , Eq)
+
+instance Engine InsideAppend where
+	listIn xs 			= Append (Right xs)
+	prev (Append (Right _ )) 	= Nothing 
+	prev (Append (Left [] )) 	= error "empty Append Left"
+	prev (Append (Left (l:ls))) 	= Just $ Inside ls l [] 
+	prev (Inside [] x ls) 		= Just $ Append (Right (x:ls)) 
+	prev (Inside (l:ls) x rs) 	= Just $ Inside ls l (x:rs) 
+	next (Append (Right [] )) 	= Nothing
+	next (Append (Right (r:rs))) 	= Just $ Inside [] r rs 
+	next (Append (Left [] )) 	= error "empty Append Left"
+	next (Append (Left _ )) 	= Nothing
+	next (Inside ls x [] ) 		= Just $ Append (Left (x:ls)) 
+	next (Inside ls x (r:rs)) 	= Just $ Inside (x:ls) r rs 
+	end w@ (Append (Left _)) 	= Just w
+	end w 				= next w >>= end
+	start w@ (Append (Right _)) 	= Just w
+	start w 			= prev w >>= start 
+	pos (Append (Left ls)) 		= End (length ls + 1)
+	pos (Append (Right _)) 		= Begin
+	pos (Inside ls _ _) 		= Line $ length ls + 1
+	del (Append _) 			= Nothing
+	del (Inside [] _ [] ) 		= Just $ Append (Right []) 
+	del (Inside ls _ [] ) 		= Just $ Append (Left ls) 
+	del (Inside ls _ (r:rs)) 	= Just $ Inside ls r rs
+	deln n w 	| n == 0 	= Just w
+		 	| True 		= del w >>= deln (n-1)
+	add xs (Append (Left _ )) 	= Nothing
+	add xs (Append (Right rs)) 	= Just $ Append $ Right (xs ++ rs)
+	add xs (Inside ls x rs) 	= Just $ Inside ls x (xs ++ rs) 
+	ins xs w 			= prev w >>= add xs >>= next 
+	jump n w 			= start w >>= rjump n 
+	listOut w 			= start w >>= \(Append (Right rs)) -> return rs
+	linen 0 _ 			= Just []
+	linen _ (Append _) 		= Nothing
+	linen n w@ (Inside _ x _ ) 	= next w >>= linen (n - 1) >>= Just . (x:)
+	
+	tillend w 			= filter isInside (runner next w)
+
+	fromstart w			= reverse $ filter isInside (runner prev w)
+
+	fwdcycle w			= filter isInside $ runner next w ++ reverse (runner prev w) ++ [w]
+	bwdcycle w			= filter isInside $ runner prev w ++ reverse (runner next w) ++ [w] 
+
+isInside	:: InsideAppend -> Bool
+isInside (Inside _ _ _) = True
+isInside _		= False
+
+runner 	:: Change InsideAppend -> InsideAppend -> [InsideAppend]
+runner op w = maybe [] (\w -> (w : runner op w)) (op w)
+
+prop_E1_IA = prop_E1 :: (W InsideAppend) -> String -> Bool 
+--prop_Empty_IA = prop_Empty :: 
+t = listIn ["paolo","va","in","bici"] :: InsideAppend
+
+ addfile ./docs/src/Editor.html hunk ./docs/src/Editor.html 1 + + + + +Haskell Code by HsColour + + + +
{-# LANGUAGE MultiParamTypeClasses,NoMonomorphismRestriction,FlexibleContexts,FlexibleInstances,UndecidableInstances #-}
+
+-- | Main datas and types for the editor
+module Editor
+where
+
+import Control.Monad.State
+import Control.Monad.Reader
+import Control.Monad.Error
+
+import Undo
+import Engine
+
+
+-- | Stato is parametrized on an Engine instance and hold the engine with the last regex entered , regex G and g are not implemented now
+data Stato w = Stato {
+	file 		:: w,			-- ^ data holding the file 
+	lastre 		:: String, 		-- ^ a regex
+	filename	:: Maybe String,	-- ^ the file we are editing
+	pending		:: Maybe Command,	-- ^ a sensible state for data lost
+	lastsaved	:: Maybe w
+	} deriving (Show,Eq)
+
+-- | the core editor runs under the state monad with state (Stato w) .
+-- Wrapped around a monad (IO mainly) to permit console input and output of commands with IO
+-- and testing with State
+type StatoE m w = UndoT (Stato w) m
+
+liftStatoE	:: Ctx m w => StatoE m w a -> Editor m w a
+liftStatoE 	= lift  
+
+-- | push a new file (data 'Engine' instance) in the core State, pushing the old state in the undo stack
+hputfile 	:: Ctx m w => w -> Editor m w ()
+hputfile x 	= get >>= \y -> liftStatoE $ hput y {file = x}
+
+putfile x 	= get >>= \y -> put y {file = x}
+putlastre x	= get >>= \y -> put y {lastre = x} 
+setfilename x	= get >>= \y -> put y {filename = x} 
+setpending x	= get >>= \y -> put y {pending = x} 
+setlastsaved 	= get >>= \y -> put y {lastsaved = Just (file y)} 
+unsetlastsaved	= get >>= \y -> put y {lastsaved = Nothing}
+
+
+	
+
+-- | placeholder for the two constraints
+class (Engine w , SIO m, HCtx m (Stato w) ) => Ctx m w 
+instance (Engine w , SIO m, HCtx m (Stato w) ) => Ctx m w 
+
+-- | the errors (monad failers) which can break the monad flow
+data Err 
+	= StopErr 		-- ^ issued on ctrl-d or q command (q not implemented)
+	| ParserErr String 	-- ^ command line was not parsed to a CompleteCommand
+	| RegexUnmatched	-- ^ the regex doesn't match a line
+	| EvalErr Err	 	-- ^ something bad happened in the evaluation process
+	| BackendErr 		-- ^ lines were addressed out of file (see 'Engine')
+	| Ahi String 		-- ^ uncontrolled errors
+	| FileReadErr String	-- ^ io error trying to load a file
+	| FileNameMissing	-- ^ filename is not set
+	| FileWriteErr String	-- ^ io error trying to write the file
+	| ExternalCommandErr String -- ^ io error executing an external program
+	| PendingState Command 	-- ^ a sensible data discarding command has been entered
+	| NoMoreUndo		-- ^ reached the first state remembered
+	| NoMoreRedo		-- ^ reached the last state remembered
+	| CommandHelpMissing	-- ^ a help for a missing command was asked
+	| CommandHelpParseErr String  	-- ^ error parsing the help for commands
+	deriving Show	
+
+instance Error Err where
+	noMsg 	= Ahi "nomsg"
+	strMsg 	= Ahi
+
+-- | a layer for IO simulation, see "Main" for the real program one and "Test" for tests
+class (Monad m) => SIO m where
+	-- | accepts a prompt and should return Nothing on eof else a line of input
+	inputSio 	:: String -> m (Maybe String) 	
+	outputSio 	:: String -> m ()		-- ^ output a normal string
+	historySio 	:: String -> m ()		-- ^ put a line in the history (which is global)
+	errorSIO 	:: String -> m ()		-- ^ output an error string
+	readfileSio	:: String -> ErrorT String m String			-- ^ read a file
+	writefileSio	:: String -> String -> ErrorT String m ()		-- ^ write a file
+	-- | runs an external command , first arg is the command
+	-- the output is returned or an error is signalled in the errort monad
+	externalSio 	:: String  	  -> ErrorT String m String
+	-- the path for the command help file
+	commandhelpSIO	:: m FilePath
+
+liftSio :: Ctx m w => m a -> Editor m w a
+liftSio = lift . lift 
+
+-- | commands for the editor	
+data Command
+	-- | get some text and add it after the addressed line
+	= Append 
+	-- | get some text and add it before the addressed line
+	| Insert 
+	-- | get some text and add it in place of some deleted lines
+	| Change 
+	-- | delete some lines
+	| Delete 
+	-- | print some lines
+	| Print 
+	-- | get some commands and  execute them on each line matching a regex
+	| SmallG String 	-- not implemented
+	-- | interactively execute commands on each line matching a regex
+	| BigG String		-- not implemented
+	-- | Change the addressed line
+	| NoCommand
+	-- | Load a file 
+	| Edit String
+	-- | Write the file
+	| Write
+	-- | Write a new file
+	| WriteNew String 
+	-- | Set filename
+	| SetFilename String
+	-- | Print filename
+	| GetFilename
+	-- | Load the output of an external command
+	| EditExternal String
+	-- | Revert the last change if ever
+	| UndoChange
+	-- | Restore via the last change
+	| RedoChange
+	-- | Asking help
+	| HelpList
+	-- | Spedific help
+	| HelpTopic String
+	deriving (Show,Eq)
+
+
+-- | represents a line position in the file
+data Offset 
+	-- | beyond last line, the append line
+	= LastLine 
+	-- | the nth line
+	| Absolute Int 
+	-- | the line addressed by the engine
+	| Current 
+	-- | the nth line before the addressed one
+	| Prev Int 
+	-- | the nth line aftor the addressed one
+	| Next Int 
+	-- | the next line (wrapping around) matching a regex
+	| ReNext String 
+	-- | the next line matching the last learned regex 
+	| LastReNext
+	-- | the previous line (wrapping around) matching a regex
+	| RePrev String
+	-- | the previous matching the last learned regex 
+	| LastRePrev
+	-- | the line marked previously with a char
+	| MarkedAs Char deriving Show
+-- | a couple of Offsets
+data Range = Range Offset Offset deriving Show
+
+-- | wrapper a round the two possible addressing for a command Offset and Range
+data OffsetOrRange 
+	= ORO Offset 
+	| ORR Range  
+	| ORN deriving Show
+
+-- | a complete command is a Command coupled with a Range or an Offset
+data CompleteCommand = CC Command OffsetOrRange deriving Show
+
+
+-- | main datatype for the program-- beyond the core state, a simulation layer 'SIO' can be read 
+-- and errors 'Err' can be thrown to kill the monad flow
+type Editor m w	=  ErrorT Err (StatoE m w)
+
+
+-- | wrap a maybe action and throw a backend error on a Nothing 
+backend		:: Ctx m w  	
+	=> Maybe a 	-- ^ maybe action
+	-> Editor m w a	-- ^ monading 
+backend	= maybe (throwError BackendErr) return
+
+-- | execute an action on the file
+through	:: Ctx m w
+	=> (w -> Maybe a)	-- ^ an action from an engine w to a maybe
+	-> Editor m w a		-- ^ the result from Just in the Editor monad
+through f = gets file >>= backend . f
+ 
+
+-- | the inputSio action lifted to Editor
+pinput	::  Ctx m w  	=> String -> Editor m w (Maybe String)	
+pinput =  liftSio . inputSio
+
+-- | the inputSio action lifted to Editor with empty prompt
+input	:: Ctx m w  	=> Editor m w (Maybe String)
+input 	= pinput ""
+
+-- | the outputSio action lifted to Editor
+output	:: Ctx m w 	=> String -> Editor m w () 
+output = liftSio . outputSio 
+
+-- | the historySIO action lifted to Editor 
+history	:: Ctx m w 	=> String -> Editor m w ()
+history	= liftSio . historySio 
+
+-- | the errorSIO action lifted to Editor
+errorlog :: Ctx m w 	=> String -> Editor m w ()
+errorlog 	= liftSio . errorSIO 
+
+-- | editor runner .
+-- resolve the all monad from a core state to another
+run	:: Ctx m w  	
+	=> Editor m w a 	-- ^ the action to run
+	-> Stato w 		-- ^ the initial state 
+	-> m (Stato w)		-- ^ the final state wrapped in the monad choosen for the SIO
+
+run editor w = flip execUndoT w $ runErrorT editor >>= \x -> 
+	case x of 	Left err -> lift $ errorSIO (show err)
+	          	Right _  -> return ()
+
+
+ addfile ./docs/src/Engine.html hunk ./docs/src/Engine.html 1 + + + + +Haskell Code by HsColour + + + +
-- | Abstraction on a "zipped" list. Use these instances to have a list cursored on a position, also 
+-- called double linked list.
+module Engine where
+
+import Test.QuickCheck
+import Control.Monad
+import Data.Maybe
+import Data.List
+
+-- | represent an action, which can fail with Nothing , an index error
+type Change a = a -> Maybe a
+
+-- | Pos represent the position addressed in the engine
+data Pos 
+	-- | the engine addresses a real line 
+	= Line { 
+	nth :: Int -- ^ The index of the line starting from 1 
+	}
+	-- | the engine addresses before first line , if ever present
+	| Begin 	
+	-- | the engine addresses after last line
+	| End {
+	lns :: Int -- ^ The number of lines in the engine
+	}
+	deriving Show
+-- | relative distance between two positions
+distance (Line n) (Line m) 	= m - n +1
+distance Begin    (Line m)	= m
+distance (Line n) (End m) 	= m - n
+distance Begin    (End m)	= m
+distance _ _ 			= 0	 
+
+-- | the class to implement for holding a list of elements with a cursor on them
+class Eq a  => Engine a where
+	
+	-- | An empty engine
+	empty 		:: a 			
+	empty 		= listIn []
+	-- | An engine is isomorphic to a list
+	listIn		:: [String] -> a 	
+	-- | Extract the list from the engine
+	listOut 	:: a -> Maybe [String] 	
+	-- | Extract n lines from the position addressed
+	linen		:: Int -> a -> Maybe [String]	 
+	-- | Extract the addressed line
+	line 		:: a -> Maybe String	
+	line w 		= head `fmap` linen 1 w
+	-- | Possibly set the addressed line to the nth line
+	jump 		:: Int -> Change a	
+	-- | Insert some lines before the addressed line
+	ins		:: [String] -> Change a	
+	-- | Insert some lines after the addressed line
+	add		:: [String] -> Change a 
+	-- | Delete the addressed line , address the next one
+	del 		:: Change a		
+	-- | Delete n lines from the addressed position
+	deln 		:: Int -> Change a	
+	-- | Address an append position
+	end 		:: Change a 	
+	-- | Address before the first line
+	start		:: Change a	
+	-- | The number of the addressed line
+	pos		:: a -> Pos	
+	-- | Address the next line
+	next		:: Change a	
+	-- | Address the prev line
+	prev 		:: Change a 	
+	-- | Jump back n lines 
+	prevn 		:: Int -> Change a	
+	prevn 0 w	= Just w		
+	prevn n w 	= prev w >>= prevn (n-1) 
+	-- | Jump ahead n lines
+	nextn 		:: Int -> Change a	
+	nextn 0 w	= Just w
+	nextn n w 	= next w >>= nextn (n-1) 
+	-- | Jump n lines relative to the addredded line
+	rjump		:: Int -> Change a	
+	rjump n		= iterateM n (if n > 0 then next else prev) where
+		iterateM n f w 	| n > 0 = f w >>= iterateM (n - 1) f
+				| True = Just w
+	-- | Create all the engines from the addressed one to the last one 
+	tillend		:: a -> [a]
+	-- | all the next engines from the addressed next to itself , wrapping around
+	fwdcycle 	:: a -> [a]
+	-- | Create all the engines from the start to the addressed one included
+	fromstart	:: a -> [a]
+	-- | all the prev engines from the addressed prev to itself , wrapping around
+	bwdcycle	:: a -> [a]
+
+-- | last element if present
+last 	:: Engine w 	=> Change w
+last t = end t >>= prev
+-- | first element if present
+first 	:: Engine w 	=> Change w
+first t = start t >>= next
+
+newtype W w = W w deriving Show
+instance (Eq w,Engine w) => Arbitrary (W w) where
+	arbitrary = do n <- choose (0,10)
+		       ws <- replicateM n $ replicateM 15 $ choose ('a','z')
+		       return $ W $ listIn ws
+	coarbitrary = undefined	
+instance Arbitrary Char where
+	arbitrary = choose ('a','z')
+	coarbitrary = undefined
+
+
+
+
+prop_E1 :: (Engine w) => W w -> String -> Bool
+prop_E1 (W y) = \x -> (add [x] y >>= listOut) == Just (x:fromJust (listOut y))
+
+propInOut f xs  = Just $ listIn xs >>= f >>= listOut        
+prop_Empty (W y) = (y == empty) ==> prev y == Nothing && next y == Nothing
+prop_toEnd (W y) =  (y /= empty) ==> let Just ls = length `fmap` listOut y 
+			in collect ls  $ nextn (ls +1) y == end y && nextn ls y == (end y >>= prev)
+prop_toEndAndBack (W y) = (y /= empty) ==> let Just ls = length `fmap` listOut y	
+			in collect ls $ (end y >>= start) == Just y
+prop_add (W y) xs = (add xs y >>= listOut) == Just xs 
+--prop_ins (W y) xs = (listIn xs >>= end >>= ins xs >>= listOut) == Just (head xs:head
+--
+-- data Prop w = forall p . (Engine w) => Prop w (\w -> \p -> Property)
+
+ addfile ./docs/src/Eval.html hunk ./docs/src/Eval.html 1 + + + + +Haskell Code by HsColour + + + +
-- | 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 w  
+	=> CompleteCommand	-- ^ the command to match for execution
+	-> Editor m w ()	-- ^ 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 w => Either String () -> Editor m w ()
+writefail 	= either (throwError . FileWriteErr) return
+
+-- | dump the engine content to a file via writefileSio
+write 	:: Ctx m w 
+	=> String 		-- ^ filename
+	-> Editor m w ()	-- ^ 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 w => Editor m w String -> Editor m w String
+getname defaul 	= gets filename >>= maybe defaul return
+
+ addfile ./docs/src/Helper.html hunk ./docs/src/Helper.html 1 + + + + +Haskell Code by HsColour + + + +
{-# LANGUAGE ParallelListComp #-}
+-- | Parse and pretty print the string of help of commands 
+module Helper where
+import Control.Monad
+import Text.ParserCombinators.Parsec.Prim
+import Text.ParserCombinators.Parsec.Char
+import Text.ParserCombinators.Parsec.Token
+import Text.ParserCombinators.Parsec.Combinator
+import Text.PrettyPrint (render,text,nest, (<>),(<+>),($$),sep)
+import Data.List (transpose,find)
+
+
+-- |structure for the help of a command
+data CommandHelp = CommandHelp {
+	name 		:: String, 	-- ^ the command name
+	synopsis	:: String, 	-- ^ how to run it
+	descriptions	:: [String],	-- ^ aspects
+	errors		:: [String],	-- ^ errors explanations
+	implementation	:: String	-- ^ implementation state
+	}
+
+instance Show CommandHelp where
+	show (CommandHelp name synopsis descriptions errors implementation) = render $
+		text ("Command: " ++ name ) $$ 
+			nest 4 (
+				text ("Synopsis: " ++ synopsis) $$
+				(text ("Description: ") <> foldr1 ($$) (map text descriptions)) $$
+				(text ("Errors: ") <> foldr1 ($$) (map text errors)) $$
+				text ("Implementation: " ++ implementation)
+				)
+-- |parses a CommandHelp			
+parseACommandHelp 	:: CharParser () CommandHelp 			
+parseACommandHelp = do
+	name <- field 0 "command"
+	synopsis <- field 1 "synopsis"
+	descriptions <- many (try $ field 1 "description")
+	errors <- many (try $ field 1 "error")
+	implementation <- field 1 "implementation"
+	return $ CommandHelp name synopsis descriptions errors implementation
+		where
+	field n name = replicateM n tab >> string name >>  char ')' >> many space >> manyTill anyChar newline
+	
+-- |parses all commands help
+parseCommandsHelp 	:: CharParser () [CommandHelp]
+parseCommandsHelp = do
+	rs <- many (try $ many emptyline >> parseACommandHelp) 
+	manyTill  anyChar  eof
+	return rs
+		where
+	emptyline = manyTill space newline
+
+-- |run the parser against a string
+run 
+	:: String 			-- ^ The string to parse
+	-> GenParser Char () a 		-- ^ the parser to use
+	-> (a -> Maybe b)		-- ^ a function to use on the result , if it succed 
+	-> Either String (Maybe b)	-- ^ the error showed if it fails or the result closed
+
+run file p cl = either (Left . show) (Right . cl) (parse p "help parser" file)  
+
+-- |create a nice table from lines of words
+tabulate :: [[String]] -> String
+tabulate = render . foldr1 ($$) . tabulate' . transpose where
+	tabulate' (xs:[]) 	= map text xs
+	tabulate' (xs:yss) 	= [text x $$ nest (maximum (map length xs) + 1) y| x <- xs | y <- tabulate' yss]
+
+-- |parse a prettyprint of a list of command helps from a string
+listOfCommands 	
+	:: String 			-- ^ the string with the help inside
+	-> Either String (Maybe String)	-- ^ a parse error or Just a prettyprint of a list of command helps
+listOfCommands file = run file parseCommandsHelp (Just . tabulate . map (\c -> [synopsis c , name c]))
+
+-- |parse a prettyprint of a list of command helps from a string
+helpCommand
+	:: String 			-- ^ the command name
+	->  String 			-- ^ the string with the help inside
+	-> Either String (Maybe String)	-- ^ a parse error or (Just the command help or Nothing if the command is missing)
+helpCommand s file = run file parseCommandsHelp (\xs -> find  ((==s).name) xs >>= return . show)
+
+ addfile ./docs/src/Main.html hunk ./docs/src/Main.html 1 + + + + +Haskell Code by HsColour + + + +
{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances #-}
+module Main where
+
+import System.Console.Readline
+import Control.Exception as Exc
+import System.Process
+import System.Exit
+import System.IO
+import Control.Monad.Error
+import Text.PrettyPrint  (render,text,nest, (<>),(<+>),($$),sep)
+import Buffer
+import Editor
+import Operation
+import Eval
+import Parser
+import Engine
+import Undo 
+import Paths_Hedi
+
+-- | a SIO data made right for running the editor 
+instance SIO IO where
+	inputSio	= readline
+	outputSio 	= putStrLn
+	historySio	= addHistory
+	errorSIO	= putStrLn
+	readfileSio	= handleWith show . strictReadFile
+	writefileSio x y 	= handleWith show (writeFile x y)	
+	externalSio	= externalCommand 
+	commandhelpSIO	= getDataFileName "command.help"
+handleWith h f 	= ErrorT $ Exc.catch (Right `fmap` f) (return . Left . h)
+strictReadFile x = readFile x >>= \x -> Exc.evaluate (length x) >> return x
+
+-- |launches an external program , catching output and errors, return on exit
+externalCommand :: String -> ErrorT String IO String
+externalCommand s = ErrorT $ do
+	(_,output,error,h) <- runInteractiveCommand s
+	status <- waitForProcess h
+	output <- hGetContents output
+	error  <- hGetContents error
+	return $ case status of 
+		ExitSuccess -> Right output
+		ExitFailure _ -> Left error
+
+-- | the greetings
+greetings 	:: IO ()
+greetings = putStrLn . render $
+	text "Hedi command line editor.      " <> (
+		text "Version 0.1" $$
+		text "Released under BSD licence." $$
+		text "Copyright 2008 Paolo Veronelli" $$
+		text "Homepage http://code.haskell.org/Hedi")
+	$$ text " "
+	$$ text "Type \"he\" for help or \"he command\"  for help on command"
+	$$ text "Type \"CTRL-D\" to quit without saving"
+		
+main :: IO ()
+main 	= do
+	run 	(liftIO greetings >> commandLoop parse eval) 
+		(Stato empty "" Nothing Nothing Nothing) :: IO (Stato InsideAppend)
+	return ()
+
+
+ addfile ./docs/src/Offset.html hunk ./docs/src/Offset.html 1 + + + + +Haskell Code by HsColour + + + +
-- | Operations involving Offset and Range through Engine interface
+module Offset where
+import Text.Regex.Posix 
+import Data.List (find)
+import Data.Maybe (fromJust)
+import Control.Monad.State
+import Editor
+import Engine
+
+-- | move the cursor in the engine
+jumpE 		:: Ctx m w  	
+	=> Offset 		-- ^ the new position for the cursor
+	-> Editor m w w 	-- ^ the modified engine under the Editor
+
+jumpE Current 		= through  Just 
+jumpE LastLine 		= through  Engine.last  
+jumpE (Next n) 		= through  $ nextn n  
+jumpE (Prev n) 		= through  $ prevn n 
+jumpE (Absolute n) 	= through  $ jump n 
+jumpE (ReNext s)  	= putlastre s >> (through . finder fwdcycle) s
+jumpE LastReNext  	= gets lastre >>= through . finder fwdcycle 
+jumpE (RePrev s)  	= putlastre s >> (through . finder bwdcycle) s
+jumpE LastRePrev 	= gets lastre >>= through . finder bwdcycle 
+
+                
+finder f s = find  ((=~ s) . fromJust . line) . f
+
+-- | From a range to the tuple (nelements,starting range element)
+rangeResolve 	:: Ctx m w  
+	=> Range 			-- ^ the range to focus
+	-> Editor m w (Int,  w)	-- ^ the tuple (nelements,engine placed
+					-- at first offset of range)
+rangeResolve (Range o1 o2) 	= do 
+	w1 <- jumpE o1 
+	w2 <- jumpE o2 
+	return (distance (pos w1) (pos w2) , w1)
+
+-- | a complete backend + Editor action on an Offset
+doOffset	:: Ctx m w 	
+	=> Offset 	-- ^ Offset for the action
+	-> (a -> Editor m w b) 	-- ^ the final action
+	-> ( w -> Maybe a) 	-- ^ the backend ation
+	-> Editor m w b	-- ^ ..
+doOffset o ef mf 	= jumpE o >>= backend . mf >>= ef
+
+-- | a backend action ending in a save state for the file
+editOffset 	:: Ctx m w 
+	=> Offset 	-- ^ Offset for the backend action
+	-> ( w -> Maybe w) 	-- ^ the backend ation
+	-> Editor m w () -- ^ modified monad
+editOffset o 		= doOffset o hputfile 
+
+-- | a complete backend + Editor action on a Range
+doRange		:: Ctx m w
+	=> Range		-- ^ the addressed range
+	-> (a -> Editor m w b)	-- ^ the closing Editor action
+	-> (Int -> w -> Maybe a)	-- ^ the backend action 
+	-> Editor m w b	-- ^ ... 
+doRange r ef mf 	= rangeResolve r >>= backend . uncurry mf >>= ef
+
+editRange 	:: Ctx m w
+	=> Range		-- ^ the addressed range
+	-> (Int -> w -> Maybe w)	-- ^ the backend action 
+	-> Editor m w ()	-- ^ modified monad
+editRange r 		= doRange r hputfile
+
+
+
+ addfile ./docs/src/Operation.html hunk ./docs/src/Operation.html 1 + + + + +Haskell Code by HsColour + + + +
-- | 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 (return []) aline
+	where aline jl = inputMode >>= return . (jl:)
+
+ addfile ./docs/src/Parser.html hunk ./docs/src/Parser.html 1 + + + + +Haskell Code by HsColour + + + +
module Parser 
+where
+
+import Text.ParserCombinators.Parsec.Token 
+import Text.ParserCombinators.Parsec 
+import Text.ParserCombinators.Parsec.Language
+import Text.ParserCombinators.Parsec.Error
+
+import Editor
+import Offset
+
+
+-- | shortcut for a parser of chars with no state
+type ParseE = GenParser Char ()
+
+-- | parse an integer  number
+numero 	:: ParseE Integer
+numero = natural haskell
+
+parseFilename = manyTill anyChar ((many1 space >> return ()) <|> eof)
+parseExternalCommand = char '!' >> manyTill anyChar eof
+parseCommandName = parseFilename
+
+-- | parse an Offset
+parseOffset	:: ParseE Offset
+parseOffset = let
+	lastline 	= char '$' >> return LastLine
+	absolute 	= numero >>= return . Absolute . fromInteger
+	current 	= char '.' >> return Current
+	previous1 	= char '-' >> numero >>= return . Prev. fromInteger 
+	previous2 	= many1 (char '-') >>= return . Prev . length 
+	next1 		= (space <|> char '+') >> numero >>= return . Next . fromInteger
+	next2 		= many1 (char '+') >>= return . Next . length
+	are c 		= char c >> manyTill anyChar ((char c >> return ()) <|> eof)
+	renext 		= are '/' >>= return . ReNext
+	lastrenext 	= string "//" >> return LastReNext
+	reprev 		= are '?' >>= return . RePrev
+	lastreprev 	= string "??" >> return LastRePrev
+	markedas 	= string "'" >> lower >>= return . MarkedAs
+	in choice (map try [lastline,absolute,current,previous1,previous2,next1,next2,
+		lastrenext,renext,lastreprev,reprev,markedas]) 
+
+-- | parse a Range
+parseRange	:: ParseE Range 
+parseRange 	= let 
+	couple 	= do 
+		l <- parseOffset
+		char ','
+		r <- parseOffset
+		return $ Range l r
+	coma = char ',' >> return (Range (Absolute 1) LastLine)
+	semicoma = char ';' >> return (Range Current LastLine)
+	in choice (map try [coma,semicoma,couple])
+
+-- | defaults Offset  or Range for the commands
+defaultOR	:: Command -> OffsetOrRange
+defaultOR Append 		= ORO Current
+defaultOR Insert 		= ORO Current
+defaultOR Change 		= ORO Current
+defaultOR Print 		= ORO Current
+defaultOR (SmallG _)		= ORR (Range (Absolute 1) (Current))
+defaultOR (BigG  _)		= ORR (Range (Absolute 1) (Current))
+defaultOR Delete 		= ORO Current
+defaultOR NoCommand 		= ORN
+defaultOR (Edit _)		= ORN
+defaultOR Write 		= ORN
+defaultOR (WriteNew _) 		= ORN
+defaultOR (SetFilename _)	= ORN
+defaultOR GetFilename 		= ORN
+defaultOR (EditExternal s)  	= ORN
+defaultOR UndoChange		= ORN
+defaultOR RedoChange		= ORN
+
+-- | forces a failure for a command if a Range was parsed
+acceptOffsetOnly	:: Command -> OffsetOrRange -> ParseE ()
+acceptOffsetOnly c (ORR _) 	= pzero <?> ("only offsets for function " ++ show c ++ ".")
+acceptOffsetOnly _ _ 		= return ()
+
+-- | parse an OffsetOrRange
+parseOffsetOrRange	:: ParseE OffsetOrRange
+parseOffsetOrRange 
+	= try (parseRange >>= return . ORR) 
+	<|> try (parseOffset >>= return .ORO) 
+	<|> return ORN
+
+-- | helper for skipping a filter
+rconst	:: Command -> ParseE (OffsetOrRange -> ParseE Command)
+rconst 	= return . const . return
+
+-- | parse a function from OffsetOrRange to a parse Command
+parseCommand	:: ParseE (OffsetOrRange -> ParseE Command)
+parseCommand = let 
+	append 	=  char 'a' >> eof >> return (\r -> acceptOffsetOnly Append  r >> return Append)
+	insert	=  char 'i' >> eof >> return (\r -> acceptOffsetOnly Insert  r >> return Insert)
+	change 	=  char 'c' >> eof >> rconst Change
+	delete 	=  char 'd' >> eof >> rconst Delete
+	print  	=  char 'p' >> eof >> rconst Print
+	smallg 	=  char 'g' >> char '/' >> many1 (noneOf "/") 
+		>>= \p -> char '/' >> eof >> rconst (SmallG p)
+	bigg   	=  char 'G' >> char '/' >> many1 (noneOf "/") 
+		>>= \p -> char '/' >> eof >> rconst (BigG p)
+	nocomm 	=  eof >> rconst NoCommand 
+	extedit	= char 'e' >> many1 space >> parseExternalCommand >>= rconst . EditExternal
+	edit	= char 'e' >> many1 space >> parseFilename >>= rconst . Edit
+	writen	= char 'w' >> many1 space >> parseFilename >>= rconst . WriteNew
+	write	= char 'w' >> rconst Write 
+	setfn	= char 'f' >> many1 space >> parseFilename >>= rconst . SetFilename
+	getfn	= char 'f' >> rconst GetFilename
+	undo	= char 'u' >> rconst UndoChange
+	redo	= char 'R' >> rconst RedoChange
+	shelp	= string "he" >> many1 space >> parseCommandName >>= rconst . HelpTopic
+	help	= string "he" >> rconst HelpList
+	in 	choice (map try [append,insert,change,delete,
+	                         print,smallg,bigg,extedit,edit
+				 ,writen,write,setfn,getfn,undo,
+				 shelp,help,redo]) <|> nocomm
+
+-- | parse a CompleteCommand  made of an OffsetOrRange and a Command
+parser	::	ParseE CompleteCommand
+parser 	= do 
+	r 	<- parseOffsetOrRange 
+	c 	<- parseCommand >>= ($ r)
+	return $ CC c $ case r of 
+		ORN	-> defaultOR c
+		_	-> r
+
+-- | the parser from a String to either a String representing an error or a CompleteCommand
+parse 	:: String -> Either String CompleteCommand 
+parse s	= either (Left . show) Right $ Text.ParserCombinators.Parsec.parse parser "Command Parser" s
+	
+
+
+ addfile ./docs/src/Test.html hunk ./docs/src/Test.html 1 + + + + +Haskell Code by HsColour + + + +
{-# LANGUAGE MultiParamTypeClasses,TypeSynonymInstances,UndecidableInstances,FlexibleContexts,FlexibleInstances #-}
+-- | some framework to test Editor m w functions, providing a non IO-stacked monad m
+module Test where
+import Control.Monad.State
+import Control.Monad.Reader
+import Control.Monad.Error
+
+import Control.Monad.Writer
+
+import Buffer
+import Editor
+import Eval
+import Parser
+import Engine
+import Undo
+-- ErrorT String m String
+
+data Console = Console {cinput::[Maybe String],coutput :: [String]}
+
+type WESC = WriterT [String] (State Console)
+instance SIO WESC where
+	inputSio 	= predefinedInput
+	outputSio 	= normalOutput
+	historySio	= ignoreSio
+	errorSIO	= logerrors
+	readfileSio	= readfile
+	writefileSio	= writefile
+	externalSio	= \_ -> (ErrorT . return) (Right "")
+	commandhelpSIO	= return "command.txt"
+	
+ignoreSio 		= const $ return () :: a -> WESC ()
+predefinedInput 	= const $ get >>= \(Console i o) -> put (Console (tail i) o) >> return (head i)
+normalOutput 	s	= get >>= \(Console i o) -> put $ Console i (s:o)
+logerrors s		= tell [s]
+readfile :: String -> ErrorT String WESC String
+readfile _ =  return " " 
+writefile _ _ = return ()
+
+
+-- | Testing a console function leaving out file IO 
+commandTest 
+	:: Test  			-- ^ test to be executed
+	->  Either [String] Bool  	-- ^ Left on errors, Right with the test 
+commandTest (Test cline input textIn textOut) = let	
+	instate		= Stato (listIn textIn) "" Nothing Nothing Nothing  
+	checkstate	= Console (map Just input ++ [Nothing]) []
+	check 		= either (throwError . ParserErr) eval (parse cline) :: Editor WESC InsideAppend () 
+	done		= run check instate
+	(result,errors)	= evalState (runWriterT done) checkstate
+	in if null errors then Right ((listOut.file) result == Just textOut) else Left errors
+
+-- | valid data for testing
+data Test = Test {
+	commandT	::String,		-- ^ The command  to test
+	inputT		::[String],	-- ^ What will be eventually read as input
+	startT		::[String],	-- ^ The file as a list of line
+	endT		::[String]	-- ^ The modified file
+	}
+
+[prima,seconda,terza] = lines "prima\nseconda\nterza"
+			
+test 	= Test "$a" [prima] [seconda] [seconda,prima] 
+
+
+ addfile ./docs/src/Undo.html hunk ./docs/src/Undo.html 1 + + + + +Haskell Code by HsColour + + + +
{-# LANGUAGE NoMonomorphismRestriction,MultiParamTypeClasses,FlexibleContexts,
+ FlexibleInstances,GeneralizedNewtypeDeriving,UndecidableInstances #-}
+-- | This code has been taken from <http://haskell.org> 
+-- A Monad transformer UndoT on a state supporting undo , redo and hput to push the last state on history.
+-- Redo stack is blanked on hput
+module Undo  where
+
+import Control.Monad.State
+
+-- | State stacks wrapping states in time
+data History s = History { 
+	current :: s, 	-- ^ last state putted
+	undos :: [s], 	-- ^ the history of putted states (reversed) without the redos
+	redos :: [s] 	-- ^ history of the undo
+	} deriving Show
+
+-- | a state monad transformer with the state history
+type HStateT s m = StateT (History s) m
+
+-- | facility to write signatures context
+class (Monad m, MonadState (History s) (HStateT s m)) => HCtx m s 
+instance (Monad m, MonadState (History s) (HStateT s m)) => HCtx m s
+-- | a wrapper around HStateT to derive his classes and add an instance
+newtype Monad m => UndoT s m a = UndoT (HStateT s m a) deriving (Functor, Monad, MonadTrans, MonadIO)
+
+-- | the MonadState instance for the wrapper
+instance (Monad m) => MonadState s (UndoT s m) where
+	get = UndoT $ gets current
+	put x = UndoT $ get >>= \(History _ us rs) -> put $ History x us rs
+
+-- | tries to get back one step the state
+undo 	:: HCtx m s 
+	=> UndoT s m Bool	-- ^ False if the undo stack was empty
+undo = UndoT $ do 
+	History c us rs <- get
+	if null us then return False 
+	 else put (History (head us) (tail us) (c : rs)) >> return True
+-- | tries to get back the undo operation
+redo	:: HCtx m s
+	=> UndoT s m Bool	-- ^ False if the redo stack was empty
+redo = UndoT $ do
+	History c us rs <- get
+	if null rs then return False 
+	 else put (History (head rs) (c : us) (tail rs)) >> return True
+
+-- | push the old state in the undo stack and set the new state (alternative to put)
+hput	:: HCtx m s 
+	=> s 		-- ^ the new state to put
+	-> UndoT s m () -- ^ monading
+hput x = UndoT $ do 
+	History c undos redos <- get
+	put (History x (c:undos) [])
+
+-- | an History of one state
+blank 	:: s -> History s
+blank s = History s [] []
+
+-- | run the UndoT monad transformer spitting out the computation result in the inner monad
+evalUndoT :: (Monad m) 
+	=> UndoT s m a 	-- ^ a UndoT action
+	-> s 		-- ^ the initial state
+	-> m a		-- ^ the result
+evalUndoT (UndoT x) s = evalStateT x (blank s)
+
+-- | run the UndoT monad transformer spitting out the final state in the inner monad
+execUndoT :: (Monad m) 
+	=> UndoT s m a	-- ^ a UndoT action
+	-> s 		-- ^ the initial state
+	-> m s		-- ^ the final state
+execUndoT (UndoT x) s = liftM current $ execStateT x (blank s)
+ 
+
+ addfile ./docs/src/hscolour.css hunk ./docs/src/hscolour.css 1 + +.keyglyph, .layout {color: red;} +.keyword {color: blue;} +.comment, .comment a {color: green;} +.str, .chr {color: teal;} +.keyword,.conid, .varid, .conop, .varop, .num, .cpp, .sel, .definition {} }