blob: 88a7259360c2fb88273b6f6f8738481f2502e119 (
plain)
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
50
51
52
53
54
55
56
|
{-# LANGUAGE LambdaCase #-}
module Main where
import Control.Concurrent.MVar
import Data.Text (Text)
import qualified Data.Text as T
import System.Environment (getArgs)
import System.Exit (die)
import Ghci
import IRC
runInGhci :: Ghci -> Text -> IO (Ghci, [Text])
runInGhci ghci message = do
(ghci', output) <- runStmtClever ghci (T.unpack message)
case output of
Error "" -> return (ghci', [T.pack "Error?"])
Error err -> return (ghci', [T.pack err])
Ignored -> return (ghci', [])
Return "" -> return (ghci', [T.pack "<no output>"])
Return s -> return (ghci', [T.pack s])
mainIRC :: IO ()
mainIRC = do
ghci0 <- makeGhci
ghcivar <- newMVar ghci0
connectIRC
(\t -> T.take 2 t == T.pack "% ")
(\recvmsg -> do
putStrLn $ "Responding to " ++ T.unpack recvmsg
ghci <- takeMVar ghcivar
(ghci', msgs) <- runInGhci ghci (T.drop 2 recvmsg)
putMVar ghcivar ghci'
return msgs)
mainGHCI :: IO ()
mainGHCI = do
let loop :: Ghci -> IO ()
loop ghci = do
line <- getLine
(ghci', moutput) <- runStmtClever ghci line
case moutput of
Return output -> putStrLn $ "output = <" ++ output ++ ">"
Ignored -> putStrLn "<ignored>"
Error err -> putStrLn err
loop ghci'
makeGhci >>= loop
main :: IO ()
main = do
getArgs >>= \case
["-irc"] -> mainIRC
["-ghci"] -> mainGHCI
[] -> mainGHCI
_ -> die "Command line not recognised"
|
