src/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
50
51

{-# LANGUAGE FlexibleContexts, ViewPatterns, OverloadedStrings #-}

import           Data.PQueue.Prio.Max (MaxPQueue)
import qualified Data.PQueue.Prio.Max as MaxPQueue

import           Data.Sequence (Seq, (|>), (<|), viewl, viewr, ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq

import Data.Default.Class
import Data.Maybe (fromMaybe)

import System.Environment.XDG.BaseDir (getUserCacheFile)
import System.Environment (getProgName)
import System.Exit

import System.Console.Haskeline

import Control.Monad.State.Strict
import Control.Monad.Writer.Strict
import Control.Monad.IO.Class
  
import Types
import Utils
import Command

type SequenceT m a = WriterT History (InputT (StateT Sequence m)) a

main :: IO ()
main = do
  historyFile <- flip getUserCacheFile "history" =<< getProgName
  let
    settings = setComplete noCompletion {- TODO -} . (\x -> x { historyFile = Just historyFile }) $ defaultSettings
  void . flip runStateT def . runInputT settings . runWriterT $ runCli

runCli :: (MonadIO m, MonadException m) => SequenceT m () 
runCli = do
  input <- lift $ getInputLine "→ " 
  cmnd <- maybe (return undefined) parseCmd input
  case input of
    Nothing -> liftIO exitSuccess
    Just _ -> do
      case cmnd of
        UnknownCommand cmd -> do
          lift . outputStrLn $ "Unknown command: »" <> cmd <> "«"
        ParseError err     -> do
          lift . outputStrLn $ "Error parsing input »" <> (fromMaybe "" input) <> "«: " <> err

        Quit           -> liftIO exitSuccess
        PerformAlt alt -> apply' alt
        Step           -> undefined
  runCli