[docs
paolo.veronelli@gmail.com**20080128204945] {
addfile ./docs/Buffer.html
hunk ./docs/Buffer.html 1
+
+
+
|
|
|
Description |
Main datas and types for the editor
+ |
|
Synopsis |
|
|
|
Documentation |
|
data Stato w |
Stato is parametrized on an Engine instance and hold the engine with the last regex entered , regex G and g are not implemented now
+ | Constructors | Stato | | file :: w | data holding the file
+ | lastre :: String | a regex
+ |
|
| Instances | |
|
|
type StatoE m w = StateT (Stato w) m |
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
+ |
|
class (Engine w, Monad m) => Ctx m w |
placeholder for the two constraints
+ | | Instances | |
|
|
data Err |
the errors (monad failers) which can break the monad flow
+ | Constructors | 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 String | something bad happened in the evaluation process (not implemented)
+ | BackendErr | lines were addressed out of file (see Engine)
+ | Ahi String | uncontrolled errors
+ |
| Instances | |
|
|
data SIO m |
a layer for IO simulation, see programSIO for the real program one and testSio for tests
+ | Constructors | SIO | | inputSio :: (String -> m (Maybe String)) | accepts a prompt and should return Nothing on eof else a line of input
+ | outputSio :: (String -> m ()) | output a normal string
+ | historySio :: (String -> m ()) | put a line in the history (which is global)
+ | errorSIO :: (Err -> m ()) | output an error string
+ |
|
|
|
|
data Command |
commands for the editor
+ | Constructors | Append | get some text and add it after the addressed line
+ | Insert | get some text and add it before the addressed line
+ | Change | get some text and add it in place of some deleted lines
+ | Delete | delete some lines
+ | Print | print some lines
+ | SmallG String | get some commands and execute them on each line matching a regex
+ | BigG String | interactively execute commands on each line matching a regex
+ | NoCommand | Change the addressed line
+ |
| Instances | |
|
|
data Offset |
represents a line position in the file
+ | Constructors | LastLine | beyond last line, the append line
+ | Absolute Int | the nth line
+ | Current | the line addressed by the engine
+ | Prev Int | the nth line before the addressed one
+ | Next Int | the nth line aftor the addressed one
+ | ReNext String | the next line (wrapping around) matching a regex
+ | LastReNext | the next line matching the last learned regex
+ | RePrev String | the previous line (wrapping around) matching a regex
+ | LastRePrev | the previous matching the last learned regex
+ | MarkedAs Char | the line marked previously with a char
+ |
| Instances | |
|
|
data Range |
a couple of Offsets
+ | Constructors | | Instances | |
|
|
data OffsetOrRange |
wrapper a round the two possible addressing for a command Offset and Range
+ | Constructors | | Instances | |
|
|
data CompleteCommand |
a complete command is a Command coupled with a Range or an Offset
+ | Constructors | | Instances | |
|
|
type Editor m w = ErrorT Err (ReaderT (SIO m) (StatoE m w)) |
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
+ |
|
backend |
:: Ctx m w | | => Maybe a | maybe action
+ | -> Editor m w a | monading
+ | wrap a maybe action and throw a backend error on a Nothing
+ |
|
|
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
+ | execute an action on the file
+ |
|
|
pinput |
:: Ctx m w | | => String | the prompt
+ | -> Editor m w (Maybe String) | Nothing for eof or Just the line
+ | the inputSio action lifted to Editor
+ |
|
|
input :: Ctx m w => Editor m w (Maybe String) |
the inputSio action lifted to Editor with empty prompt
+ |
|
output |
:: Ctx m w | | => String | what to output
+ | -> Editor m w () | monading ..
+ | the outputSio action lifted to Editor
+ |
|
|
history |
:: Ctx m w | | => String | what to add to history stack
+ | -> Editor m w () | monading ..
+ | the historySIO action lifted to Editor
+ |
|
|
errorlog |
:: Ctx m w | | => Err | the error happened
+ | -> Editor m w () | monading
+ | the errorSIO action lifted to Editor
+ |
|
|
run |
:: Ctx m w | | => Editor m w a | the action to run
+ | -> SIO m | the input output simulation to be used
+ | -> Stato w | the initial state
+ | -> m (Stato w) | the final state wrapped in the monad choosen for the SIO
+ | Editor runner .
+ resolve the all monad from a core state to another
+ |
|
|
Produced by Haddock version 0.8 |
addfile ./docs/Engine.html
hunk ./docs/Engine.html 1
+
+
+ |
|
|
Description |
Abstraction on a zipped list. Use these instances to have a list cursored on a position, also
+ called double linked list.
+ |
|
Synopsis |
|
|
|
Documentation |
|
type Change a = a -> Maybe a |
represent an action, which can fail with Nothing , an index error
+ |
|
data Pos |
Pos represent the position addressed in the engine
+ | Constructors | Line | the engine addresses a real line
+ | nth :: Int | The index of the line starting from 1
+ |
| Begin | the engine addresses before first line , if ever present
+ | End | the engine addresses after last line
+ | lns :: Int | The number of lines in the engine
+ |
|
|
|
|
class Eq a => Engine a where |
the class to implement for holding a list of elements with a cursor on them
+ | | Methods | empty :: a | An empty engine
+ | | listIn :: [String] -> a | An engine is isomorphic to a list
+ | | listOut :: a -> Maybe [String] | Extract the list from the engine
+ | | linen :: Int -> a -> Maybe [String] | Extract n lines from the position addressed
+ | | line :: a -> Maybe String | Extract the addressed line
+ | | jump :: Int -> Change a | Possibly set the addressed line to the nth line
+ | | ins :: [String] -> Change a | Insert some lines before the addressed line
+ | | add :: [String] -> Change a | Insert some lines after the addressed line
+ | | del :: Change a | Delete the addressed line , address the next one
+ | | deln :: Int -> Change a | Delete n lines from the addressed position
+ | | end :: Change a | Address an append position
+ | | start :: Change a | Address before the first line
+ | | pos :: a -> Pos | The number of the addressed line
+ | | next :: Change a | Address the next line
+ | | prev :: Change a | Address the prev line
+ | | prevn :: Int -> Change a | Jump back n lines
+ | | nextn :: Int -> Change a | Jump ahead n lines
+ | | rjump :: Int -> Change a | Jump n lines relative to the addredded line
+ | | tillend :: a -> Maybe [String] | Get all the elements from the addressed one to the last one
+ | | fromstart :: a -> Maybe [String] | Get all elemnts from the start to the addressed one included
+ |
| | Instances | |
|
|
newtype W w |
Constructors | | Instances | (Eq w, Engine w) => Arbitrary (W w) | Show w => Show (W w) |
|
|
|
prop_E1 :: Engine w => W w -> String -> Bool |
|
Produced by Haddock version 0.8 |
addfile ./docs/Eval.html
hunk ./docs/Eval.html 1
+
+
+ |
|
|
Description |
Operations involving Offset and Range through Engine interface
+ |
|
Synopsis |
|
|
|
Documentation |
|
jumpE |
:: Ctx m w | | => Offset | the new position for the cursor
+ | -> Editor m w w | the modified engine under the Editor
+ | move the cursor in the engine
+ |
|
|
rangeResolve |
:: Ctx m w | | => Range | the range to focus
+ | -> Editor m w (Int, w) | the tuple (nelements,engine placed
+ at first offset of range)
+ | From a range to the tuple (nelements,starting range element)
+ |
|
|
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 | ..
+ | a complete backend + Editor action on an Offset
+ |
|
|
editOffset |
:: Ctx m w | | => Offset | Offset for the backend action
+ | -> (w -> Maybe w) | the backend ation
+ | -> Editor m w () | modified monad
+ | a backend action ending in a save state for the file
+ |
|
|
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 | ...
+ | a complete backend + Editor action on a Range
+ |
|
|
editRange |
:: Ctx m w | | => Range | the addressed range
+ | -> (Int -> w -> Maybe w) | the backend action
+ | -> Editor m w () | modified monad
+ |
|
|
Produced by Haddock version 0.8 |
addfile ./docs/Operation.html
hunk ./docs/Operation.html 1
+
+
+
addfile ./docs/doc-index-A.html
hunk ./docs/doc-index-A.html 1
+
+
+