diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-05-08 01:05:00 +0200 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-05-08 01:05:00 +0200 |
commit | 6ce5de5a227267e359aa3c38344e3858f035287d (patch) | |
tree | 445ee27f897324317cef51511363e8f13f010d1a /src/Main.hs | |
parent | c69563da3ea55820af21edb7cf2af40906630e6e (diff) | |
download | 2017-01-16_17:13:37-6ce5de5a227267e359aa3c38344e3858f035287d.tar 2017-01-16_17:13:37-6ce5de5a227267e359aa3c38344e3858f035287d.tar.gz 2017-01-16_17:13:37-6ce5de5a227267e359aa3c38344e3858f035287d.tar.bz2 2017-01-16_17:13:37-6ce5de5a227267e359aa3c38344e3858f035287d.tar.xz 2017-01-16_17:13:37-6ce5de5a227267e359aa3c38344e3858f035287d.zip |
command interpretation
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 38 |
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 | |||
6 | import Data.Sequence (Seq, (|>), (<|), viewl, viewr, ViewL(..), ViewR(..)) | 6 | import Data.Sequence (Seq, (|>), (<|), viewl, viewr, ViewL(..), ViewR(..)) |
7 | import qualified Data.Sequence as Seq | 7 | import qualified Data.Sequence as Seq |
8 | 8 | ||
9 | import Data.Text (Text) | ||
10 | import qualified Data.Text as Text | ||
11 | |||
9 | import Data.Default.Class | 12 | import Data.Default.Class |
10 | import Data.Maybe (fromMaybe) | 13 | import Data.Maybe (fromMaybe) |
11 | 14 | ||
@@ -23,30 +26,43 @@ import Types | |||
23 | import Utils | 26 | import Utils |
24 | import Command | 27 | import Command |
25 | 28 | ||
26 | type SequenceT m a = WriterT History (InputT (StateT Sequence m)) a | ||
27 | |||
28 | main :: IO () | 29 | main :: IO () |
29 | main = do | 30 | main = 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 | ||
35 | runCli :: (MonadIO m, MonadException m) => SequenceT m () | 41 | runCli :: (MonadIO m, MonadException m, SequenceM m) => InputT m () |
36 | runCli = do | 42 | runCli = 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 |