1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE TypeSynonymInstances #-}
4
5module Main (main, repl) where
6
7import Control.Monad.State.Strict
8import Data.List (isPrefixOf)
9import Data.Monoid
10import qualified Data.Set as Set
11import System.Console.Repline
12
13-------------------------------------------------------------------------------
14-- Stateful Completion
15-------------------------------------------------------------------------------
16
17type IState = (Int, Set.Set String)
18
19type Repl a = HaskelineT (StateT IState IO) a
20
21-- Evaluation
22cmd :: String -> Repl ()
23cmd input = modify . fmap $ \s -> Set.insert input s
24
25-- Completion
26comp :: (Monad m, MonadState IState m) => WordCompleter m
27comp n = do
28  (c, ns) <- get
29  return $ filter (isPrefixOf n) (Set.toList ns)
30
31-- Commands
32help :: [String] -> Repl ()
33help args = liftIO $ print $ "Help!" ++ show args
34
35puts :: [String] -> Repl ()
36puts args = modify . fmap $ \s -> Set.union s (Set.fromList args)
37
38opts :: [(String, String -> Repl ())]
39opts =
40  [ ("help", help . words), -- :help
41    ("puts", puts . words) -- :puts
42  ]
43
44ini :: Repl ()
45ini = return ()
46
47final :: Repl ExitDecision
48final = do
49  (count, s) <- get
50  if count == 0
51    then return Exit
52    else do
53      liftIO . putStrLn $ "Exit in " <> show count <> "..."
54      put (count - 1, s)
55      return Continue
56
57-- Tab completion inside of StateT
58repl :: IO ()
59repl =
60  flip evalStateT (3, Set.empty) $
61    evalRepl (const $ pure ">>> ") cmd opts Nothing Nothing (Word comp) ini final
62
63main :: IO ()
64main = pure ()
65