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

{-# 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 "→ " 
  case input of
    Nothing -> liftIO exitSuccess
    Just input' -> do
      case parseCmd input' of
        UnknownCommand help -> do
          lift . outputStrLn $ help
        ParseError err     -> do
          lift . outputStrLn $ "Error parsing input »" <> (fromMaybe "" input) <> "«: " <> err
        Empty              -> return ()

        Quit           -> liftIO exitSuccess
        _              -> undefined
  runCli