aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
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"