1 {-# LANGUAGE GeneralizedNewtypeDeriving
10 import Control.Exception
11 import Control.Monad.State
13 import Control.Applicative
14 import Control.Arrow (first, second)
30 deriving (Eq, Show, Read)
33 commands = map show [View, Edit, Next, Prev, Quit]
37 newtype Editor b a = Editor (StateT (b,Int) IO a)
38 deriving (Functor, Monad, MonadIO, MonadState (b,Int))
40 runEditor :: Buffer b => Editor b a -> b -> IO a
41 runEditor (Editor e) b = evalStateT e (b,0)
43 getCurLine :: Editor b Int
46 setCurLine :: Int -> Editor b ()
47 setCurLine = modify . second . const
49 onBuffer :: (b -> a) -> Editor b a
50 onBuffer f = gets (f . fst)
52 getBuffer :: Editor b b
53 getBuffer = onBuffer id
55 modBuffer :: (b -> b) -> Editor b ()
56 modBuffer = modify . first
58 io :: MonadIO m => IO a -> m a
63 readMay :: Read a => String -> Maybe a
64 readMay s = case reads s of
70 editor :: Buffer b => Editor b ()
71 editor = io (hSetBuffering stdout NoBuffering) >> loop
72 where loop = do prompt
74 when (cmd /= Quit) (doCommand cmd >> loop)
76 prompt :: Buffer b => Editor b ()
79 io $ putStr (show s ++ "> ")
81 getCommand :: Editor b Command
82 getCommand = io $ readCom <$> getLine
85 readCom inp@(c:cs) | isDigit c = maybe Noop Line (readMay inp)
86 | toUpper c == 'L' = Load (unwords $ words cs)
88 | otherwise = maybe Noop read $
89 find ((== toUpper c) . head) commands
91 doCommand :: Buffer b => Command -> Editor b ()
94 let ls = [(cur - 2) .. (cur + 2)]
95 ss <- mapM (\l -> onBuffer $ line l) ls
96 zipWithM_ (showL cur) ls ss
98 showL _ _ Nothing = return ()
99 showL l n (Just s) = io $ putStrLn (m ++ show n ++ ": " ++ s)
100 where m | n == l = "*"
105 io $ putStr $ "Replace line " ++ show l ++ ": "
107 modBuffer $ replaceLine l new
109 doCommand (Load filename) = do
110 mstr <- io $ handle (\(_ :: IOException) ->
111 putStrLn "File not found." >> return Nothing
113 h <- openFile filename ReadMode
115 Just <$> hGetContents h
116 maybe (return ()) (modBuffer . const . fromString) mstr
118 doCommand (Line n) = modCurLine (const n) >> doCommand View
120 doCommand Next = modCurLine (+1) >> doCommand View
121 doCommand Prev = modCurLine (subtract 1) >> doCommand View
123 doCommand Quit = return () -- do nothing, main loop notices this and quits
125 doCommand Help = io . putStr . unlines $
126 [ "v --- view the current location in the document"
127 , "n --- move to the next line"
128 , "p --- move to the previous line"
129 , "l --- load a file into the editor"
130 , "e --- edit the current line"
132 , "? --- show this list of commands"
135 doCommand Noop = return ()
137 inBuffer :: Buffer b => Int -> Editor b Bool
139 nl <- onBuffer numLines
140 return (n >= 0 && n < nl)
142 modCurLine :: Buffer b => (Int -> Int) -> Editor b ()
145 nl <- onBuffer numLines
146 setCurLine . max 0 . min (nl - 1) $ f l