/src/Local.hs

 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 }