{-# LANGUAGE Rank2Types #-}
module Vgrep.Event (
    -- * Event handling
    -- | An event handler is a function
    --
    -- @
    -- handleEvent :: 'Control.Monad.State.MonadState' s m => e -> s -> 'Next' (m 'Redraw')
    -- @
    --
    -- where @e@ is the event type and @s@ is the state of the handler. The
    -- 'Next' type determines the type of action to be performed. The state
    -- @s@ is passed as a parameter so the handler can decide which type of
    -- action to perform, while not being able to modify the state.
    --
    -- Event handlers form a 'Monoid' where the first handler that triggers
    -- will perform the action:
    --
    -- @
    -- (handleSome <> handleOther) event state
    -- @
    --
    -- is identical to
    --
    -- @
    -- case handleSome event state of
    --     Skip -> handleOther event state
    --     action -> action
    -- @
      Next (..)
    , Redraw (..)
    , Interrupt (..)

    -- * Dispatching Events
    , dispatch
    , dispatchMap

    -- ** Re-exports
    , module Data.Map
    ) where

import           Control.Monad.IO.Class
import           Data.Map               (Map, fromList)
import qualified Data.Map               as M

import Vgrep.Environment


-- | The type of action to be performed on an event.
data Next a
    = Skip
    -- ^ Do not handle the event (fall-through to other event handlers)

    | Continue a
    -- ^ Handle the event by performing an action

    | Interrupt Interrupt
    -- ^ Interrupt the application

-- | The first event handler that triggers (i. e. does not return 'Skip')
-- handles the event.
instance Semigroup (Next a) where
    Next a
Skip        <> :: Next a -> Next a -> Next a
<> Next a
next       = Next a
next
    Next a
next        <> Next a
_other     = Next a
next

instance Monoid (Next a) where
    mempty :: Next a
mempty = Next a
forall a. Next a
Skip

instance Functor Next where
    fmap :: (a -> b) -> Next a -> Next b
fmap a -> b
f = \case Next a
Skip        -> Next b
forall a. Next a
Skip
                   Continue a
a  -> b -> Next b
forall a. a -> Next a
Continue (a -> b
f a
a)
                   Interrupt Interrupt
i -> Interrupt -> Next b
forall a. Interrupt -> Next a
Interrupt Interrupt
i

data Redraw
    = Redraw
    -- ^ Indicates that the state has been changed visibly, so the screen
    -- should be refreshed.

    | Unchanged
    -- ^ The state has not changed or the change would not be visible, so
    -- refreshing the screen is not required.

instance Semigroup Redraw where
    Redraw
Unchanged <> :: Redraw -> Redraw -> Redraw
<> Redraw
Unchanged = Redraw
Unchanged
    Redraw
_         <> Redraw
_         = Redraw
Redraw

instance Monoid Redraw where
    mempty :: Redraw
mempty = Redraw
Unchanged


data Interrupt
    = Suspend (forall m. MonadIO m => Environment -> m ())
    -- ^ Suspend the application and run the action, e. g. invoking an
    -- external process, then resume the application.

    | Halt
    -- ^ Shut down.



-- | If the lookup returns @'Just' action@, then handle it with
-- @'Continue' action'@, otherwise 'Skip' this event handler.
dispatch :: (e -> Maybe a) -> e -> Next a
dispatch :: (e -> Maybe a) -> e -> Next a
dispatch e -> Maybe a
f = Next a -> (a -> Next a) -> Maybe a -> Next a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Next a
forall a. Next a
Skip a -> Next a
forall a. a -> Next a
Continue (Maybe a -> Next a) -> (e -> Maybe a) -> e -> Next a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Maybe a
f

-- | Special case of 'dispatch' where actions are looked up from a map.
dispatchMap :: Ord e => Map e a -> e -> Next a
dispatchMap :: Map e a -> e -> Next a
dispatchMap Map e a
m = (e -> Maybe a) -> e -> Next a
forall e a. (e -> Maybe a) -> e -> Next a
dispatch (e -> Map e a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map e a
m)