PageRenderTime 16ms CodeModel.GetById 11ms app.highlight 3ms RepoModel.GetById 1ms app.codeStats 0ms

/src/Local.hs

http://github.com/Eelis/geordi
Haskell | 71 lines | 59 code | 11 blank | 1 comment | 4 complexity | 605df44cde7e605f181913df7d89cdd2 MD5 | raw file
 1{-# LANGUAGE UnicodeSyntax, CPP #-}
 2
 3import qualified System.Environment
 4import qualified RequestEval
 5import qualified System.Console.Readline as RL
 6import qualified Codec.Binary.UTF8.String as UTF8
 7import qualified Cxx.Show
 8
 9import Request (Response(..), HistoryModification(..), Context(..), modify_history)
10import Control.Monad (forM_, when)
11import Control.Monad.Fix (fix)
12import System.IO (utf8, stdout, hSetEncoding)
13import System.Console.GetOpt (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt, usageInfo)
14import System.Locale.SetLocale (setLocale, Category(..))
15import Data.IORef (newIORef, readIORef, writeIORef)
16
17import Prelude hiding ((.), readFile)
18import Util
19
20data Opt = Help deriving Eq
21
22optsDesc :: [OptDescr Opt]
23optsDesc = [Option "h" ["help"] (NoArg Help) "Display this help and exit."]
24
25help :: String
26help = usageInfo "Usage: sudo geordi-local [option]... [request]...\nOptions:" optsDesc ++ "\nSee README.xhtml for more information."
27
28getArgs :: IO ([Opt], [String])
29getArgs = do
30  args  System.Environment.getArgs
31  case getOpt RequireOrder optsDesc args of
32    (_, _, err:_)  fail $ init err
33    (opts, rest, [])  return (opts, rest)
34
35make_history_adder :: IO (String  IO ())
36make_history_adder = do
37  r  newIORef Nothing
38  return $ \s  do
39    prev  readIORef r
40    when (Just s  prev) $ do
41      RL.addHistory s
42      writeIORef r (Just s)
43
44data Memory = Memory { context :: Context, last_outputs :: [String] }
45
46blankMemory :: Memory
47blankMemory = Memory (Context Cxx.Show.noHighlighting False []) []
48
49main :: IO ()
50main = do
51 setLocale LC_ALL (Just "")
52 hSetEncoding stdout utf8
53 RL.initialize -- Reads stuff from files not present in the chroot.
54 (opts, rest)  getArgs
55 if Help  opts then putStrLn help else do
56  eval  RequestEval.evaluator
57  forM_ rest $ \l  do Request.Response _ output  eval l (Context Cxx.Show.noHighlighting False []) []; putStrLn output
58  addHistory  make_history_adder
59  when (rest == []) $ flip fix blankMemory $ \loop mem  RL.readline "geordi: " >>= \line  case line of
60    Nothing  putNewLn
61    Just ""  loop mem
62    Just l  do
63      Response history_modification output  eval l (context mem) []
64      case history_modification of
65        Just (AddLast e)  addHistory $ UTF8.encodeString $ show $ fst e
66        Just (ReplaceLast e)  addHistory $ UTF8.encodeString $ show $ fst e
67        _  return ()
68      putStrLn $ describe_new_output (last_outputs mem) output
69      loop Memory
70        { context = maybe id modify_history history_modification $ context mem
71        , last_outputs = output : last_outputs mem }