app/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

module Main where

import qualified Compiler as C
import Control.Monad.IO.Class
import qualified Data.Map as M
import qualified Interpreter as I
import qualified Parser as P
import System.Console.Haskeline
import qualified Text.Megaparsec as MP
import Text.Pretty.Simple

ppr :: Show a => a -> IO ()
ppr =
  pPrintOpt
    CheckColorTty
    defaultOutputOptionsDarkBg
      { outputOptionsCompactParens = True
      , outputOptionsIndentAmount = 2
      , outputOptionsPageWidth = 80
      }

interpret :: String -> InputT IO ()
interpret = liftIO . lex
  where
    lex input =
      case MP.parse P.lexPrlg "-" input of
        Left bundle -> putStr (MP.errorBundlePretty bundle)
        Right toks -> parse toks
    parse toks =
      case MP.parse P.parsePrlg "-" toks of
        Left bundle -> putStr (MP.errorBundlePretty bundle)
        Right ast -> prologize ast
    prologize ast = ppr $ map (P.ast2prlg P.defaultOps) ast

main :: IO ()
main =
  runInputT defaultSettings $ do
    outputStrLn "PRLG."
    loop
  where
    loop :: InputT IO ()
    loop = do
      minput <- getInputLine "|= "
      case minput of
        Nothing -> return ()
        Just input -> do
          interpret input
          loop