{-# LANGUAGE Rank2Types #-}
module Vgrep.Event (
Next (..)
, Redraw (..)
, Interrupt (..)
, dispatch
, dispatchMap
, module Data.Map
) where
import Control.Monad.IO.Class
import Data.Map (Map, fromList)
import qualified Data.Map as M
import Vgrep.Environment
data Next a
= Skip
| Continue a
| Interrupt Interrupt
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
| Unchanged
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 ())
| Halt
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
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)