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
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Main (main, repl) where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State.Strict
import Data.List (isPrefixOf)
import Data.Monoid
import qualified Data.Set as Set
import System.Console.Repline
-------------------------------------------------------------------------------
-- Stateful Completion
-------------------------------------------------------------------------------
type IState = (Int, Set.Set String)
type Repl a = HaskelineT (StateT IState IO) a
-- Evaluation
cmd :: String -> Repl ()
cmd input = modify . fmap $ \s -> Set.insert input s
-- Completion
comp :: (Monad m, MonadState IState m) => WordCompleter m
comp n = do
(c, ns) <- get
return $ filter (isPrefixOf n) (Set.toList ns)
-- Commands
help :: [String] -> Repl ()
help args = liftIO $ print $ "Help!" ++ show args
puts :: [String] -> Repl ()
puts args = modify . fmap $ \s -> Set.union s (Set.fromList args)
opts :: [(String, String -> Repl ())]
opts =
[ ("help", help . words), -- :help
("puts", puts . words) -- :puts
]
ini :: Repl ()
ini = return ()
final :: Repl ExitDecision
final = do
(count, s) <- get
if count == 0
then return Exit
else do
liftIO . putStrLn $ "Exit in " <> show count <> "..."
put (count - 1, s)
return Continue
-- Tab completion inside of StateT
repl :: IO ()
repl =
flip evalStateT (3, Set.empty) $
evalRepl (const $ pure ">>> ") cmd opts Nothing Nothing (Word comp) ini final
main :: IO ()
main = pure ()
|
