[ErrorT on SIO paolo.veronelli@gmail.com**20080202161630] { hunk ./Buffer.hs 2 -module Buffer (InsideAppend) +module Buffer (InsideAppend (..)) hunk ./Buffer.hs 11 - = Inside {left :: [String], cursor ::String , right :: [String]} - | Append { elems :: Either [String] [String]} + -- | 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. + } hunk ./Editor.hs 40 + | FileNotFound -- ^ error try to load a file hunk ./Editor.hs 54 - errorSIO :: Err -> m () -- ^ output an error string + errorSIO :: Err -> m (), -- ^ output an error string + readfileSio :: String -> ErrorT String m String, -- ^ read a file + writefileSio :: String -> String -> ErrorT String m () -- ^ write a file hunk ./Editor.hs 78 + -- | Load a file + | Edit String hunk ./Editor.hs 116 + hunk ./Engine.hs 83 - -- | all the next engines from the addressed one to its previous , wrapping around + -- | all the next engines from the addressed next to itself , wrapping around hunk ./Engine.hs 87 + -- | all the prev engines from the addressed prev to itself , wrapping around hunk ./Engine.hs 90 +-- | 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 + hunk ./Engine.hs 109 --- | 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 hunk ./Eval.hs 4 +import System.IO +import Control.Monad.Trans +import Control.Monad.Reader +import Control.Monad.Error hunk ./Eval.hs 36 +eval (CC (Edit e) _) = asks readfileSio >>= lift . lift . lift . runErrorT . ($ e) >>= + either output (putfile . listIn . lines) + + hunk ./Main.hs 5 +--import Control.Exception +import Control.Monad.Error hunk ./Main.hs 16 - +handleWith h f = ErrorT $ catch (Right `fmap` f) (return . Left . h) hunk ./Main.hs 20 -programSio = SIO readline putStrLn addHistory print +programSio = SIO readline putStrLn addHistory print (handleWith show . readFile) (\x y -> handleWith show (writeFile x y)) hunk ./Parser.hs 20 +filename = manyTill anyChar ((many1 space >> return ()) <|> eof) hunk ./Parser.hs 62 +defaultOR (Edit _) = ORN +defaultOR (Write _) = ORN hunk ./Parser.hs 94 - in choice (map try [append,insert,change,delete,print,smallg,bigg]) <|> nocomm + edit = char 'e' >> many space >> filename >>= rconst . Edit + write = char 'w' >> rconst . Write + in choice (map try [append,insert,change,delete,print,smallg,bigg,edit]) <|> nocomm hunk ./docs/Buffer.html 81 +>
= Inside {
left :: [String]
cursor :: String
right :: [String]
}
| Append {
elems :: (Either [String] [String])
}
Constructors
Insidethe cursor when its pointing to a real line (eg line function doesn't fail) +
left :: [String]lines before the cursor (reversed order) +
cursor :: Stringaddressed line +
right :: [String]lines after the cursor +
Appendthe cursor is pointing either to insert at the front of the file or + append at the end of the file. +
elems :: (Either [String] [String])Left lines is in append mode, Right is in insert at front mode. +
| FileNotFoundreadfileSio :: (String -> ErrorT String m String)writefileSio :: (String -> String -> ErrorT String m ())| Edit StringFileNotFounderror try to load a file +readfileSio :: (String -> ErrorT String m String)read a file +writefileSio :: (String -> String -> ErrorT String m ())write a file +Edit StringLoad a file +newtype W w = W wnewtype W w = W wall the next engines from the addressed one to its previous , wrapping around +>all the next engines from the addressed next to itself , wrapping around hunk ./docs/Engine.html 959 +>all the prev engines from the addressed prev to itself , wrapping around +last :: Engine w => Change wlast element if present +first :: Engine w => Change wfirst element if present +last :: Engine w => Change wlast element if present -first :: Engine w => Change wfirst element if present -1 (Data Constructor)Buffer2 (Data Constructor)cursorBufferEditEditorelemsBufferFileNotFoundEditorInsideBufferleftBufferreadfileSioEditorrightBufferwritefileSioEditor