    {-# LANGUAGE FlexibleContexts  #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# OPTIONS_HADDOCK show-extensions #-}

    -- |
    -- Module      :  Yi.Keymap.Keys
    -- License     :  GPL-2
    -- Maintainer  :  yi-devel@googlegroups.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Combinators for building keymaps.

    module Yi.Keymap.Keys
        (
         module Yi.Event,
         module Yi.Interact,
         printableChar, textChar,
         charOf, shift, meta, ctrl, super, hyper, spec, char,
         (>>!), (>>=!), (?>>), (?>>!), (?*>>), (?*>>!),
         ctrlCh, metaCh, hyperCh,
         optMod,
         pString
        ) where

    import Prelude       hiding (error)

    import Control.Monad (unless)
    import qualified Control.Monad.Fail as Fail
    import Data.Char     (isAlpha, isPrint, toUpper)
    import Data.List     (nub, sort)
    import Yi.Debug      (error)
    import Yi.Event      (Event (..), Key (..), Modifier (..), eventToChar, prettyEvent)
    import Yi.Interact   hiding (write)
    import Yi.Keymap     (Action, KeymapM, YiAction, write)

    printableChar :: (Fail.MonadFail m, MonadInteract m w Event) => m Char
    printableChar :: forall (m :: * -> *) w.
    (MonadFail m, MonadInteract m w Event) =>
    m Char
    printableChar = do
      Event (KASCII c) [] <- m Event
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    m event
    anyEvent
      unless (isPrint c) $
           fail "unprintable character"
      return c

    -- | Parse any character that can be inserted in the text.
    textChar :: KeymapM Char
    textChar :: KeymapM Char
    textChar = do
        -- Why only ASCII?
        Event (KASCII c) [] <- I Event Action Event
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    m event
    anyEvent
        return c

    pString :: (MonadInteract m w Event) => String -> m [Event]
    pString :: forall (m :: * -> *) w.
    MonadInteract m w Event =>
    String -> m [Event]
    pString = [Event] -> m [Event]
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    [event] -> m [event]
    events ([Event] -> m [Event])
    -> (String -> [Event]) -> String -> m [Event]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Event) -> String -> [Event]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Event
    char

    charOf :: (Fail.MonadFail m, MonadInteract m w Event) => (Event -> Event) -> Char -> Char -> m Char
    charOf :: forall (m :: * -> *) w.
    (MonadFail m, MonadInteract m w Event) =>
    (Event -> Event) -> Char -> Char -> m Char
    charOf Event -> Event
    modifier Char
    l Char
    h =
        do Event (KASCII c) _ <- Event -> Event -> m Event
    forall e (m :: * -> *) w.
    (Ord e, MonadInteract m w e) =>
    e -> e -> m e
    eventBetween (Event -> Event
    modifier (Event -> Event) -> Event -> Event
    forall a b. (a -> b) -> a -> b
    $ Char -> Event
    char Char
    l) (Event -> Event
    modifier (Event -> Event) -> Event -> Event
    forall a b. (a -> b) -> a -> b
    $ Char -> Event
    char Char
    h)
           return c

    shift,ctrl,meta,super,hyper :: Event -> Event
    shift :: Event -> Event
    shift (Event (KASCII Char
    c) [Modifier]
    ms) | Char -> Bool
    isAlpha Char
    c = Key -> [Modifier] -> Event
    Event (Char -> Key
    KASCII (Char -> Char
    toUpper Char
    c)) [Modifier]
    ms
                                | Bool
    otherwise = Text -> Event
    forall a. Text -> a
    error Text
    "shift: unhandled event"
    shift (Event Key
    k [Modifier]
    ms) = Key -> [Modifier] -> Event
    Event Key
    k ([Modifier] -> Event) -> [Modifier] -> Event
    forall a b. (a -> b) -> a -> b
    $ [Modifier] -> [Modifier]
    forall a. Eq a => [a] -> [a]
    nub ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
    forall a b. (a -> b) -> a -> b
    $ [Modifier] -> [Modifier]
    forall a. Ord a => [a] -> [a]
    sort (Modifier
    MShiftModifier -> [Modifier] -> [Modifier]
    forall a. a -> [a] -> [a]
    :[Modifier]
    ms)

    ctrl :: Event -> Event
    ctrl (Event Key
    k [Modifier]
    ms) = Key -> [Modifier] -> Event
    Event Key
    k ([Modifier] -> Event) -> [Modifier] -> Event
    forall a b. (a -> b) -> a -> b
    $ [Modifier] -> [Modifier]
    forall a. Eq a => [a] -> [a]
    nub ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
    forall a b. (a -> b) -> a -> b
    $ [Modifier] -> [Modifier]
    forall a. Ord a => [a] -> [a]
    sort (Modifier
    MCtrlModifier -> [Modifier] -> [Modifier]
    forall a. a -> [a] -> [a]
    :[Modifier]
    ms)

    meta :: Event -> Event
    meta (Event Key
    k [Modifier]
    ms) = Key -> [Modifier] -> Event
    Event Key
    k ([Modifier] -> Event) -> [Modifier] -> Event
    forall a b. (a -> b) -> a -> b
    $ [Modifier] -> [Modifier]
    forall a. Eq a => [a] -> [a]
    nub ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
    forall a b. (a -> b) -> a -> b
    $ [Modifier] -> [Modifier]
    forall a. Ord a => [a] -> [a]
    sort (Modifier
    MMetaModifier -> [Modifier] -> [Modifier]
    forall a. a -> [a] -> [a]
    :[Modifier]
    ms)

    super :: Event -> Event
    super (Event Key
    k [Modifier]
    ms) = Key -> [Modifier] -> Event
    Event Key
    k ([Modifier] -> Event) -> [Modifier] -> Event
    forall a b. (a -> b) -> a -> b
    $ [Modifier] -> [Modifier]
    forall a. Eq a => [a] -> [a]
    nub ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
    forall a b. (a -> b) -> a -> b
    $ [Modifier] -> [Modifier]
    forall a. Ord a => [a] -> [a]
    sort (Modifier
    MSuperModifier -> [Modifier] -> [Modifier]
    forall a. a -> [a] -> [a]
    :[Modifier]
    ms)

    hyper :: Event -> Event
    hyper (Event Key
    k [Modifier]
    ms) = Key -> [Modifier] -> Event
    Event Key
    k ([Modifier] -> Event) -> [Modifier] -> Event
    forall a b. (a -> b) -> a -> b
    $ [Modifier] -> [Modifier]
    forall a. Eq a => [a] -> [a]
    nub ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
    forall a b. (a -> b) -> a -> b
    $ [Modifier] -> [Modifier]
    forall a. Ord a => [a] -> [a]
    sort (Modifier
    MHyperModifier -> [Modifier] -> [Modifier]
    forall a. a -> [a] -> [a]
    :[Modifier]
    ms)

    char :: Char -> Event
    char :: Char -> Event
    char Char
    '\t' = Key -> [Modifier] -> Event
    Event Key
    KTab []
    char Char
    '\r' = Key -> [Modifier] -> Event
    Event Key
    KEnter []
    char Char
    '\n' = Key -> [Modifier] -> Event
    Event Key
    KEnter []
    char Char
    c = Key -> [Modifier] -> Event
    Event (Char -> Key
    KASCII Char
    c) []

    ctrlCh :: Char -> Event
    ctrlCh :: Char -> Event
    ctrlCh = Event -> Event
    ctrl (Event -> Event) -> (Char -> Event) -> Char -> Event
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Event
    char

    metaCh :: Char -> Event
    metaCh :: Char -> Event
    metaCh = Event -> Event
    meta (Event -> Event) -> (Char -> Event) -> Char -> Event
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Event
    char

    hyperCh :: Char -> Event
    hyperCh :: Char -> Event
    hyperCh = Event -> Event
    hyper (Event -> Event) -> (Char -> Event) -> Char -> Event
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Event
    char

    -- | @optMod f ev@ produces a 'MonadInteract' that consumes @ev@ or @f ev@
    optMod ::(Fail.MonadFail m, MonadInteract m w Event) => (Event -> Event) -> Event -> m Event
    optMod :: forall (m :: * -> *) w.
    (MonadFail m, MonadInteract m w Event) =>
    (Event -> Event) -> Event -> m Event
    optMod Event -> Event
    f Event
    ev = [Event] -> m Event
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event, MonadFail m) =>
    [event] -> m event
    oneOf [Event
    ev, Event -> Event
    f Event
    ev]

    -- | Convert a special key into an event
    spec :: Key -> Event
    spec :: Key -> Event
    spec Key
    k = Key -> [Modifier] -> Event
    Event Key
    k []

    -- | > p >>! act = p >> 'write' act
    (>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => m b -> a -> m ()
    m b
    p >>! :: forall (m :: * -> *) a x b.
    (MonadInteract m Action Event, YiAction a x, Show x) =>
    m b -> a -> m ()
    >>! a
    act = m b
    p m b -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> a -> m ()
    forall (m :: * -> *) ev a x.
    (MonadInteract m Action ev, YiAction a x, Show x) =>
    a -> m ()
    write a
    act

    -- | > p >>=! act = p >>= 'write' . act
    (>>=!) :: (MonadInteract m Action Event, YiAction a x, Show x) => m b -> (b -> a) -> m ()
    m b
    p >>=! :: forall (m :: * -> *) a x b.
    (MonadInteract m Action Event, YiAction a x, Show x) =>
    m b -> (b -> a) -> m ()
    >>=! b -> a
    act = m b
    p m b -> (b -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= a -> m ()
    forall (m :: * -> *) ev a x.
    (MonadInteract m Action ev, YiAction a x, Show x) =>
    a -> m ()
    write (a -> m ()) -> (b -> a) -> b -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    act

    -- | @ ev ?>> proc = 'event' ev >> proc @
    (?>>) :: (MonadInteract m action Event) => Event -> m a -> m a
    Event
    ev ?>> :: forall (m :: * -> *) action a.
    MonadInteract m action Event =>
    Event -> m a -> m a
    ?>> m a
    proc = Event -> m Event
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    event -> m event
    event Event
    ev m Event -> m a -> m a
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> m a
    proc

    -- | @ ev ?>>! act = 'event' ev >> 'write' act @
    (?>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => Event -> a -> m ()
    Event
    ev ?>>! :: forall (m :: * -> *) a x.
    (MonadInteract m Action Event, YiAction a x, Show x) =>
    Event -> a -> m ()
    ?>>! a
    act = Event -> m Event
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    event -> m event
    event Event
    ev m Event -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> a -> m ()
    forall (m :: * -> *) ev a x.
    (MonadInteract m Action ev, YiAction a x, Show x) =>
    a -> m ()
    write a
    act

    -- | @ ev ?*>> proc = 'events' ev >> proc @
    (?*>>) :: (MonadInteract m action Event) => [Event] -> m a -> m a
    [Event]
    ev ?*>> :: forall (m :: * -> *) action a.
    MonadInteract m action Event =>
    [Event] -> m a -> m a
    ?*>> m a
    proc = [Event] -> m [Event]
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    [event] -> m [event]
    events [Event]
    ev m [Event] -> m a -> m a
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> m a
    proc

    -- | @ ev ?*>>! act = 'events' ev >> 'write' act @
    (?*>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => [Event] -> a -> m ()
    [Event]
    ev ?*>>! :: forall (m :: * -> *) a x.
    (MonadInteract m Action Event, YiAction a x, Show x) =>
    [Event] -> a -> m ()
    ?*>>! a
    act = [Event] -> m [Event]
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    [event] -> m [event]
    events [Event]
    ev m [Event] -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> a -> m ()
    forall (m :: * -> *) ev a x.
    (MonadInteract m Action ev, YiAction a x, Show x) =>
    a -> m ()
    write a
    act

    infixl 1 >>!
    infixl 1 >>=!
    infixr 0 ?>>!
    infixr 0 ?>>
    infixr 0 ?*>>!
    infixr 0 ?*>>