module System.Console.Haskeline.Command(
Effect(..),
KeyMap(..),
CmdM(..),
Command,
KeyCommand,
KeyConsumed(..),
withoutConsuming,
keyCommand,
(>|>),
(>+>),
try,
effect,
clearScreenCmd,
finish,
failCmd,
simpleCommand,
charCommand,
setState,
change,
changeFromChar,
(+>),
useChar,
choiceCmd,
keyChoiceCmd,
keyChoiceCmdM,
doBefore
) where
import Data.Char(isPrint)
import Control.Applicative(Applicative(..))
import Control.Monad(ap, mplus, liftM)
import Control.Monad.Trans.Class
import System.Console.Haskeline.LineState
import System.Console.Haskeline.Key
data Effect = LineChange (Prefix -> LineChars)
| PrintLines [String]
| ClearScreen
| RingBell
lineChange :: LineState s => s -> Effect
lineChange :: forall s. LineState s => s -> Effect
lineChange = (Prefix -> LineChars) -> Effect
LineChange forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s. LineState s => Prefix -> s -> LineChars
lineChars
data KeyMap a = KeyMap {forall a. KeyMap a -> Key -> Maybe (KeyConsumed a)
lookupKM :: Key -> Maybe (KeyConsumed a)}
data KeyConsumed a = NotConsumed a | Consumed a
instance Functor KeyMap where
fmap :: forall a b. (a -> b) -> KeyMap a -> KeyMap b
fmap a -> b
f KeyMap a
km = forall a. (Key -> Maybe (KeyConsumed a)) -> KeyMap a
KeyMap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. KeyMap a -> Key -> Maybe (KeyConsumed a)
lookupKM KeyMap a
km
instance Functor KeyConsumed where
fmap :: forall a b. (a -> b) -> KeyConsumed a -> KeyConsumed b
fmap a -> b
f (NotConsumed a
x) = forall a. a -> KeyConsumed a
NotConsumed (a -> b
f a
x)
fmap a -> b
f (Consumed a
x) = forall a. a -> KeyConsumed a
Consumed (a -> b
f a
x)
data CmdM m a = GetKey (KeyMap (CmdM m a))
| DoEffect Effect (CmdM m a)
| CmdM (m (CmdM m a))
| Result a
type Command m s t = s -> CmdM m t
instance Monad m => Functor (CmdM m) where
fmap :: forall a b. (a -> b) -> CmdM m a -> CmdM m b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Monad m => Applicative (CmdM m) where
pure :: forall a. a -> CmdM m a
pure = forall (m :: * -> *) a. a -> CmdM m a
Result
<*> :: forall a b. CmdM m (a -> b) -> CmdM m a -> CmdM m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad m => Monad (CmdM m) where
return :: forall a. a -> CmdM m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
GetKey KeyMap (CmdM m a)
km >>= :: forall a b. CmdM m a -> (a -> CmdM m b) -> CmdM m b
>>= a -> CmdM m b
g = forall (m :: * -> *) a. KeyMap (CmdM m a) -> CmdM m a
GetKey forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CmdM m b
g) KeyMap (CmdM m a)
km
DoEffect Effect
e CmdM m a
f >>= a -> CmdM m b
g = forall (m :: * -> *) a. Effect -> CmdM m a -> CmdM m a
DoEffect Effect
e (CmdM m a
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CmdM m b
g)
CmdM m (CmdM m a)
f >>= a -> CmdM m b
g = forall (m :: * -> *) a. m (CmdM m a) -> CmdM m a
CmdM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CmdM m b
g) m (CmdM m a)
f
Result a
x >>= a -> CmdM m b
g = a -> CmdM m b
g a
x
type KeyCommand m s t = KeyMap (Command m s t)
instance MonadTrans CmdM where
lift :: forall (m :: * -> *) a. Monad m => m a -> CmdM m a
lift m a
m = forall (m :: * -> *) a. m (CmdM m a) -> CmdM m a
CmdM forall a b. (a -> b) -> a -> b
$ do
a
x <- m a
m
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. a -> CmdM m a
Result a
x
keyCommand :: KeyCommand m s t -> Command m s t
keyCommand :: forall (m :: * -> *) s t. KeyCommand m s t -> Command m s t
keyCommand KeyCommand m s t
km = \s
s -> forall (m :: * -> *) a. KeyMap (CmdM m a) -> CmdM m a
GetKey forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ s
s) KeyCommand m s t
km
useKey :: Key -> a -> KeyMap a
useKey :: forall a. Key -> a -> KeyMap a
useKey Key
k a
x = forall a. (Key -> Maybe (KeyConsumed a)) -> KeyMap a
KeyMap forall a b. (a -> b) -> a -> b
$ \Key
k' -> if Key
kforall a. Eq a => a -> a -> Bool
==Key
k' then forall a. a -> Maybe a
Just (forall a. a -> KeyConsumed a
Consumed a
x) else forall a. Maybe a
Nothing
useChar :: (Char -> Command m s t) -> KeyCommand m s t
useChar :: forall (m :: * -> *) s t.
(Char -> Command m s t) -> KeyCommand m s t
useChar Char -> Command m s t
act = forall a. (Key -> Maybe (KeyConsumed a)) -> KeyMap a
KeyMap forall a b. (a -> b) -> a -> b
$ \Key
k -> case Key
k of
Key Modifier
m (KeyChar Char
c) | Char -> Bool
isPrint Char
c Bool -> Bool -> Bool
&& Modifier
mforall a. Eq a => a -> a -> Bool
==Modifier
noModifier
-> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> KeyConsumed a
Consumed (Char -> Command m s t
act Char
c)
Key
_ -> forall a. Maybe a
Nothing
withoutConsuming :: Command m s t -> KeyCommand m s t
withoutConsuming :: forall (m :: * -> *) s t. Command m s t -> KeyCommand m s t
withoutConsuming = forall a. (Key -> Maybe (KeyConsumed a)) -> KeyMap a
KeyMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> KeyConsumed a
NotConsumed
choiceCmd :: [KeyMap a] -> KeyMap a
choiceCmd :: forall a. [KeyMap a] -> KeyMap a
choiceCmd = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {a}. KeyMap a -> KeyMap a -> KeyMap a
orKM forall {a}. KeyMap a
nullKM
where
nullKM :: KeyMap a
nullKM = forall a. (Key -> Maybe (KeyConsumed a)) -> KeyMap a
KeyMap forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. Maybe a
Nothing
orKM :: KeyMap a -> KeyMap a -> KeyMap a
orKM (KeyMap Key -> Maybe (KeyConsumed a)
f) (KeyMap Key -> Maybe (KeyConsumed a)
g) = forall a. (Key -> Maybe (KeyConsumed a)) -> KeyMap a
KeyMap forall a b. (a -> b) -> a -> b
$ \Key
k -> Key -> Maybe (KeyConsumed a)
f Key
k forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Key -> Maybe (KeyConsumed a)
g Key
k
keyChoiceCmd :: [KeyCommand m s t] -> Command m s t
keyChoiceCmd :: forall (m :: * -> *) s t. [KeyCommand m s t] -> Command m s t
keyChoiceCmd = forall (m :: * -> *) s t. KeyCommand m s t -> Command m s t
keyCommand forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [KeyMap a] -> KeyMap a
choiceCmd
keyChoiceCmdM :: [KeyMap (CmdM m a)] -> CmdM m a
keyChoiceCmdM :: forall (m :: * -> *) a. [KeyMap (CmdM m a)] -> CmdM m a
keyChoiceCmdM = forall (m :: * -> *) a. KeyMap (CmdM m a) -> CmdM m a
GetKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [KeyMap a] -> KeyMap a
choiceCmd
infixr 6 >|>
(>|>) :: Monad m => Command m s t -> Command m t u -> Command m s u
Command m s t
f >|> :: forall (m :: * -> *) s t u.
Monad m =>
Command m s t -> Command m t u -> Command m s u
>|> Command m t u
g = \s
x -> Command m s t
f s
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Command m t u
g
infixr 6 >+>
(>+>) :: Monad m => KeyCommand m s t -> Command m t u -> KeyCommand m s u
KeyCommand m s t
km >+> :: forall (m :: * -> *) s t u.
Monad m =>
KeyCommand m s t -> Command m t u -> KeyCommand m s u
>+> Command m t u
g = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) s t u.
Monad m =>
Command m s t -> Command m t u -> Command m s u
>|> Command m t u
g) KeyCommand m s t
km
try :: Monad m => KeyCommand m s s -> Command m s s
try :: forall (m :: * -> *) s.
Monad m =>
KeyCommand m s s -> Command m s s
try KeyCommand m s s
f = forall (m :: * -> *) s t. [KeyCommand m s t] -> Command m s t
keyChoiceCmd [KeyCommand m s s
f,forall (m :: * -> *) s t. Command m s t -> KeyCommand m s t
withoutConsuming forall (m :: * -> *) a. Monad m => a -> m a
return]
infixr 6 +>
(+>) :: Key -> a -> KeyMap a
+> :: forall a. Key -> a -> KeyMap a
(+>) = forall a. Key -> a -> KeyMap a
useKey
finish :: (Monad m, Result s) => Command m s (Maybe String)
finish :: forall (m :: * -> *) s.
(Monad m, Result s) =>
Command m s (Maybe String)
finish = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Result s => s -> String
toResult
failCmd :: Monad m => Command m s (Maybe a)
failCmd :: forall (m :: * -> *) s a. Monad m => Command m s (Maybe a)
failCmd s
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
effect :: Effect -> CmdM m ()
effect :: forall (m :: * -> *). Effect -> CmdM m ()
effect Effect
e = forall (m :: * -> *) a. Effect -> CmdM m a -> CmdM m a
DoEffect Effect
e forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. a -> CmdM m a
Result ()
clearScreenCmd :: Command m s s
clearScreenCmd :: forall (m :: * -> *) a. a -> CmdM m a
clearScreenCmd = forall (m :: * -> *) a. Effect -> CmdM m a -> CmdM m a
DoEffect Effect
ClearScreen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. a -> CmdM m a
Result
simpleCommand :: (LineState s, Monad m) => (s -> m (Either Effect s))
-> Command m s s
simpleCommand :: forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand s -> m (Either Effect s)
f = \s
s -> do
Either Effect s
et <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s -> m (Either Effect s)
f s
s)
case Either Effect s
et of
Left Effect
e -> forall (m :: * -> *). Effect -> CmdM m ()
effect Effect
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return s
s
Right s
t -> forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
setState s
t
charCommand :: (LineState s, Monad m) => (Char -> s -> m (Either Effect s))
-> KeyCommand m s s
charCommand :: forall s (m :: * -> *).
(LineState s, Monad m) =>
(Char -> s -> m (Either Effect s)) -> KeyCommand m s s
charCommand Char -> s -> m (Either Effect s)
f = forall (m :: * -> *) s t.
(Char -> Command m s t) -> KeyCommand m s t
useChar forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> s -> m (Either Effect s)
f
setState :: (Monad m, LineState s) => Command m s s
setState :: forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
setState s
s = forall (m :: * -> *). Effect -> CmdM m ()
effect (forall s. LineState s => s -> Effect
lineChange s
s) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return s
s
change :: (LineState t, Monad m) => (s -> t) -> Command m s t
change :: forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(s -> t) -> Command m s t
change = (forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
setState forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
changeFromChar :: (LineState t, Monad m) => (Char -> s -> t) -> KeyCommand m s t
changeFromChar :: forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(Char -> s -> t) -> KeyCommand m s t
changeFromChar Char -> s -> t
f = forall (m :: * -> *) s t.
(Char -> Command m s t) -> KeyCommand m s t
useChar forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(s -> t) -> Command m s t
change forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> s -> t
f
doBefore :: Monad m => Command m s t -> KeyCommand m t u -> KeyCommand m s u
doBefore :: forall (m :: * -> *) s t u.
Monad m =>
Command m s t -> KeyCommand m t u -> KeyCommand m s u
doBefore Command m s t
cmd = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Command m s t
cmd forall (m :: * -> *) s t u.
Monad m =>
Command m s t -> Command m t u -> Command m s u
>|>)