blob: 86c87719d091cf913c949e7c772a6071e516141a (
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
57
58
59
60
61
62
63
64
65
66
67
68
|
{-# 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.Text (Text)
import qualified Data.Text as Text
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
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 $ runCli
-- data Cmd = PerformAlt Alteration (Maybe Comment)
-- | ShowTip
-- | ShowHistory (Maybe Integer)
-- | Dump
runCli :: (MonadIO m, MonadException m, SequenceM m) => InputT m ()
runCli = do
input <- getInputLine "→ "
case input of
Nothing -> liftIO exitSuccess
Just input' -> do
cmd <- parseCmd input'
case cmd of
UnknownCommand help -> do
outputStrLn $ help
ParseError err -> do
outputStrLn $ "Error parsing input »" <> (fromMaybe "" input) <> "«: " <> err
Empty -> return ()
Quit -> liftIO exitSuccess
Dump -> get >>= outputStrLn . show
ShowTip -> do
tip <- fmap snd <$> gets (MaxPQueue.getMax . ctxSequence)
case tip of
Just entity -> outputStrLn . Text.unpack $ showEntity entity
Nothing -> outputStrLn "Queue is currently empty"
ShowHistory ns -> do
let sel = maybe id takeR ns
mapM_ (outputStrLn . show) =<< sel <$> gets ctxHistory
PerformAlt alt comment -> apply' alt comment
_ -> undefined
runCli
|
