Main.hs 2.27 KB
Newer Older
1
{-# LANGUAGE RecordWildCards, FlexibleContexts #-}
2 3
module Main where

4
import Control.Monad.IO.Class       (liftIO)
5
import Control.Monad.State.Strict   (StateT, evalStateT, gets, modify)
Erick Gonzalez's avatar
Erick Gonzalez committed
6
import Data.Default                 (def)
7
import System.Console.StructuredCLI
8
import Text.Read                    (readMaybe)
9

10 11
data AppState = AppState { bars :: Int,
                           bazs :: Int }
12

13
type StateM = StateT AppState IO
14 15

root :: CommandsT StateM ()
16 17 18
root = do
  basic
  foo
19
  grob
20

21
basic :: CommandsT StateM ()
22
basic = do
23 24
  command "top" "return to the top of the tree" top
  command "exit" "go back one level up" exit
25

26
foo :: CommandsT StateM ()
27
foo =
28
    command "foo" "pity the foo" (return NewLevel) >+ do
29 30 31 32
      basic
      bar
      baz

33
bar :: CommandsT StateM ()
34
bar = param "bar" "<number of bars>" parseBars setBars >+ do
35
        basic
36
        frob
37
            where setBars int = do
38
                    bars <- gets bars
39
                    modify $ \s -> s { bars = bars + int }
40
                    return NewLevel
41

42
baz :: CommandsT StateM ()
43
baz = command' "baz" "do the baz thing" checkBazs $ do
44
        n <- modify incBaz >> gets bazs
45
        liftIO . putStrLn $ "You have bazzed " ++ show n ++ " times"
46
        return NoAction
47
            where incBaz s@AppState{..} = s { bazs = bazs + 1 }
48 49 50
                  checkBazs = do
                    bazCount <- gets bazs
                    return $ bazCount < 3 -- after 3 bazs, disable baz command
51 52

frob :: CommandsT StateM ()
53 54
frob = command "frob" "frob this level" $ do
         n <- gets bars
55
         liftIO . putStrLn $ "frobbing " ++ show n ++ " bars"
56
         return NoAction
57

58 59 60 61 62 63
grob :: CommandsT StateM ()
grob = custom "grob" "grob something" (parseOneOf options "what to grob") always $
         const (return NoAction)
           where options = ["fee", "fa", "fo", "fum"]
                 always  = return True

64 65
parseBars :: Validator StateM Int
parseBars = return . readMaybe
Erick Gonzalez's avatar
Erick Gonzalez committed
66

67
main :: IO ()
68 69 70 71 72 73 74 75
main = do
  let state0 = AppState 0 0
  evalStateT run state0
      where run = do
              result <- runCLI "some CLI" settings root
              either (error.show) return result
            settings = def { getBanner = "Some CLI Application\nTab completion is your friend!",
                             getHistory = Just ".someCLI.history" }