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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, FlexibleInstances, TypeOperators, DoAndIfThenElse, GeneralizedNewtypeDeriving, Trustworthy #-}
module System.Console.Wizard.Pure
( Pure
, UnexpectedEOI (..)
, runPure
, PureState (..)
) where
import System.Console.Wizard
import System.Console.Wizard.Internal
import Control.Monad.Trans
import Control.Monad.State.Lazy
import Control.Monad.Trans.Maybe
import Control.Applicative((<$>))
import Data.Typeable
import Data.Sequence(Seq, (|>), (><), fromList, empty)
import Control.Monad
import Control.Exception
import Control.Arrow
import Data.Foldable(toList)
-- | Thrown if the wizard ever unexpectedly runs out of input.
data UnexpectedEOI = UnexpectedEOI deriving (Show, Typeable)
instance Exception UnexpectedEOI
-- | The pure backend is actually just a simple state monad, with the following state.
type PureState = ([String], Seq Char)
-- | Run a wizard in the Pure backend
runPure :: Wizard Pure a -> String -> (Maybe a, String)
runPure wz input = let (a,(_,o)) = runState (run wz) (lines input, empty)
in (a, toList o)
getPureLine :: State PureState String
getPureLine = do crashIfNull
x <- head . fst <$> get
modify (first tail)
return x
crashIfNull :: State PureState ()
crashIfNull = do (x, y ) <- get
when (null x) $ throw UnexpectedEOI
getPureChar :: State PureState Char
getPureChar = do crashIfNull
x <- null . head . fst <$> get
if x then do
modify (first tail)
return '\n'
else do
r <- head . head . fst <$> get
modify (first (\ (x : r) -> tail x : r))
return r
outputPure :: String -> State PureState ()
outputPure s = modify (second (>< fromList s))
>> modify (\s -> s `seq` s)
outputLnPure :: String -> State PureState ()
outputLnPure s = modify (second $ (|> '\n') . (>< fromList s))
>> modify (\s -> s `seq` s)
instance Run (State PureState) Output where runAlgebra (Output s w) = outputPure s >> w
instance Run (State PureState) OutputLn where runAlgebra (OutputLn s w) = outputLnPure s >> w
instance Run (State PureState) Line where runAlgebra (Line s w) = getPureLine >>= w
instance Run (State PureState) Character where runAlgebra (Character s w) = getPureChar >>= w
-- | The 'Pure' backend supports only simple input and output.
-- Support for 'Password' and 'LinePrewritten' features can be added with
-- a shim from "System.Console.Wizard.Shim".
newtype Pure a = Pure ((Output :+: OutputLn :+: Line :+: Character) a)
deriving ( (:<:) Output
, (:<:) OutputLn
, (:<:) Line
, (:<:) Character
, Functor
, Run (State PureState)
)
|
