forked from JPMoresmau/scion-class-browser
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Main.hs
50 lines (44 loc) · 2.6 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
module Main where
import qualified Codec.Compression.Zlib as Zlib
import Control.Monad.State
import Data.Aeson
import qualified Data.Aeson.Types as T
import qualified Data.Attoparsec.Char8 as Atto
import qualified Data.Attoparsec.Types as Atto
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Server.PersistentCommands
import System.Console.Haskeline
import System.IO (hFlush, stdout, stderr)
import System.Environment (getArgs)
import Data.Version (showVersion)
import Paths_scion_browser
import Scion.PersistentBrowser.Util (logToStdout)
import GHC.IO.Handle (hDuplicate,hDuplicateTo)
main :: IO ()
main = do args <- getArgs
case args of
("--version":_) -> putStrLn ("scion-browser executable, version " ++ (showVersion version))
_ -> do runStateT (runInputT defaultSettings loop) initialState
return ()
loop :: InputT BrowserM ()
loop = do maybeLine <- getInputLine ""
case maybeLine of
Nothing -> return () -- ctrl+D or EOF
Just line -> do
case Atto.parse json (BS.pack line) of
Atto.Fail _ _ e -> (liftIO $ logToStdout ("error in command: " ++ e)) >> loop
Atto.Partial _ -> (liftIO $ logToStdout ("incomplete data error in command: ")) >> loop
Atto.Done _ value -> case T.parse parseJSON value of
Error e -> (liftIO $ logToStdout ("error in command: " ++ e)) >> loop
Success cmd -> do
stdout_excl <- liftIO $ hDuplicate stdout
liftIO $ hDuplicateTo stderr stdout -- redirect stdout to stderr
(res, continue) <- lift $ executeCommand cmd
liftIO $ hDuplicateTo stdout_excl stdout -- redirect stdout to original stdout
let encoded = LBS.append (encode res) "\n"
compressed = Zlib.compressWith Zlib.defaultCompressParams { Zlib.compressLevel = Zlib.bestSpeed } encoded
liftIO $ LBS.putStr compressed
liftIO $ hFlush stdout
if continue then loop else return ()