Move EventM from Brick.Types to Brick.Types.EventM, stop exporting internals of EventM

This commit is contained in:
Jonathan Daugherty 2022-07-17 19:03:29 -07:00
parent 83015ff1ac
commit 293ba9ceba
4 changed files with 32 additions and 20 deletions

View File

@ -108,6 +108,7 @@ library
other-modules: other-modules:
Brick.Types.Common Brick.Types.Common
Brick.Types.TH Brick.Types.TH
Brick.Types.EventM
Brick.Types.Internal Brick.Types.Internal
Brick.Widgets.Internal Brick.Widgets.Internal

View File

@ -79,7 +79,7 @@ import Graphics.Vty
import Graphics.Vty.Attributes (defAttr) import Graphics.Vty.Attributes (defAttr)
import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan) import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan)
import Brick.Types (EventM(..)) import Brick.Types.EventM
import Brick.Types.Internal import Brick.Types.Internal
import Brick.Widgets.Internal import Brick.Widgets.Internal
import Brick.AttrMap import Brick.AttrMap

View File

@ -1,9 +1,6 @@
-- | Basic types used by this library. -- | Basic types used by this library.
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Brick.Types module Brick.Types
( -- * The Widget type ( -- * The Widget type
@ -30,7 +27,7 @@ module Brick.Types
, ClickableScrollbarElement(..) , ClickableScrollbarElement(..)
-- * Event-handling types -- * Event-handling types
, EventM(..) , EventM
, BrickEvent(..) , BrickEvent(..)
, withLens , withLens
, nestEventM , nestEventM
@ -104,7 +101,6 @@ where
import Lens.Micro (_1, _2, to, (^.), Lens') import Lens.Micro (_1, _2, to, (^.), Lens')
import Lens.Micro.Type (Getting) import Lens.Micro.Type (Getting)
import Lens.Micro.Mtl ((.=), use) import Lens.Micro.Mtl ((.=), use)
import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail) import Control.Monad.Fail (MonadFail)
#endif #endif
@ -114,6 +110,7 @@ import Graphics.Vty (Attr)
import Brick.Types.TH import Brick.Types.TH
import Brick.Types.Internal import Brick.Types.Internal
import Brick.Types.EventM
import Brick.AttrMap (AttrName, attrMapLookup) import Brick.AttrMap (AttrName, attrMapLookup)
-- | The type of padding. -- | The type of padding.
@ -169,20 +166,6 @@ withLens target act = do
target .= val' target .= val'
return result return result
-- | The monad in which event handlers run. Although it may be tempting
-- to dig into the reader value yourself, just use
-- 'Brick.Main.lookupViewport'.
newtype EventM n s a =
EventM { runEventM :: ReaderT (EventRO n) (StateT (EventState n s) IO) a
}
deriving ( Functor, Applicative, Monad, MonadIO
, MonadThrow, MonadCatch, MonadMask, MonadFail
)
instance MonadState s (EventM n s) where
get = EventM $ lift $ gets applicationState
put s = EventM $ lift $ modify $ \es -> es { applicationState = s }
-- | The rendering context's current drawing attribute. -- | The rendering context's current drawing attribute.
attrL :: forall r n. Getting r (Context n) Attr attrL :: forall r n. Getting r (Context n) Attr
attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL)) attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL))

28
src/Brick/Types/EventM.hs Normal file
View File

@ -0,0 +1,28 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
module Brick.Types.EventM
( EventM(..)
)
where
import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
import Control.Monad.Reader
import Control.Monad.State.Strict
import Brick.Types.Internal
-- | The monad in which event handlers run. Although it may be tempting
-- to dig into the reader value yourself, just use
-- 'Brick.Main.lookupViewport'.
newtype EventM n s a =
EventM { runEventM :: ReaderT (EventRO n) (StateT (EventState n s) IO) a
}
deriving ( Functor, Applicative, Monad, MonadIO
, MonadThrow, MonadCatch, MonadMask, MonadFail
)
instance MonadState s (EventM n s) where
get = EventM $ lift $ gets applicationState
put s = EventM $ lift $ modify $ \es -> es { applicationState = s }