summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs38
1 files changed, 27 insertions, 11 deletions
diff --git a/src/Main.hs b/src/Main.hs
index c3c1d7e..86c8771 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -6,6 +6,9 @@ import qualified Data.PQueue.Prio.Max as MaxPQueue
6import Data.Sequence (Seq, (|>), (<|), viewl, viewr, ViewL(..), ViewR(..)) 6import Data.Sequence (Seq, (|>), (<|), viewl, viewr, ViewL(..), ViewR(..))
7import qualified Data.Sequence as Seq 7import qualified Data.Sequence as Seq
8 8
9import Data.Text (Text)
10import qualified Data.Text as Text
11
9import Data.Default.Class 12import Data.Default.Class
10import Data.Maybe (fromMaybe) 13import Data.Maybe (fromMaybe)
11 14
@@ -23,30 +26,43 @@ import Types
23import Utils 26import Utils
24import Command 27import Command
25 28
26type SequenceT m a = WriterT History (InputT (StateT Sequence m)) a
27
28main :: IO () 29main :: IO ()
29main = do 30main = do
30 historyFile <- flip getUserCacheFile "history" =<< getProgName 31 historyFile <- flip getUserCacheFile "history" =<< getProgName
31 let 32 let
32 settings = setComplete noCompletion {- TODO -} . (\x -> x { historyFile = Just historyFile }) $ defaultSettings 33 settings = setComplete noCompletion {- TODO -} . (\x -> x { historyFile = Just historyFile }) $ defaultSettings
33 void . flip runStateT def . runInputT settings . runWriterT $ runCli 34 void . flip runStateT def . runInputT settings $ runCli
35
36-- data Cmd = PerformAlt Alteration (Maybe Comment)
37-- | ShowTip
38-- | ShowHistory (Maybe Integer)
39-- | Dump
34 40
35runCli :: (MonadIO m, MonadException m) => SequenceT m () 41runCli :: (MonadIO m, MonadException m, SequenceM m) => InputT m ()
36runCli = do 42runCli = do
37 input <- lift $ getInputLine "→ " 43 input <- getInputLine "→ "
38 case input of 44 case input of
39 Nothing -> liftIO exitSuccess 45 Nothing -> liftIO exitSuccess
40 Just input' -> do 46 Just input' -> do
41 cmd <- parseCmd input' 47 cmd <- parseCmd input'
42 case cmd of 48 case cmd of
43 UnknownCommand help -> do 49 UnknownCommand help -> do
44 lift . outputStrLn $ help 50 outputStrLn $ help
45 ParseError err -> do 51 ParseError err -> do
46 lift . outputStrLn $ "Error parsing input »" <> (fromMaybe "" input) <> "«: " <> err 52 outputStrLn $ "Error parsing input »" <> (fromMaybe "" input) <> "«: " <> err
47 Empty -> return () 53 Empty -> return ()
48 54
49 Quit -> liftIO exitSuccess 55 Quit -> liftIO exitSuccess
50 56
57 Dump -> get >>= outputStrLn . show
58 ShowTip -> do
59 tip <- fmap snd <$> gets (MaxPQueue.getMax . ctxSequence)
60 case tip of
61 Just entity -> outputStrLn . Text.unpack $ showEntity entity
62 Nothing -> outputStrLn "Queue is currently empty"
63 ShowHistory ns -> do
64 let sel = maybe id takeR ns
65 mapM_ (outputStrLn . show) =<< sel <$> gets ctxHistory
66 PerformAlt alt comment -> apply' alt comment
51 _ -> undefined 67 _ -> undefined
52 runCli 68 runCli