-- | The 'VgrepT' monad transformer allows reading from the 'Environment'
-- and changing the state of the 'Vgrep.App.App' or a 'Vgrep.Widget.Widget'.
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
module Vgrep.Type
  ( -- * The 'VgrepT' monad transformer
    VgrepT ()
  , Vgrep

  , mkVgrepT
  , runVgrepT

  -- ** Modifying the environment
  , modifyEnvironment

  -- ** Utilities
  , vgrepBracket

  -- * Re-exports
  , lift
  , hoist
  , module Vgrep.Environment
  , module Export
) where

import qualified Control.Exception            as E
import           Control.Lens.Compat
import           Control.Monad.Identity
import           Control.Monad.Morph
import           Control.Monad.Reader
import qualified Control.Monad.Reader         as Export
    ( MonadReader
    , ask
    , local
    )
import           Control.Monad.State.Extended
import qualified Control.Monad.State.Extended as Export
    ( MonadState
    , get
    , modify
    , put
    )
import           Lens.Micro.Mtl.Internal

import Vgrep.Environment

-- | The 'VgrepT' monad transformer is parameterized over the state @s@ of
-- a 'Vgrep.Widget.Widget' or an 'Vgepr.App.App'.
newtype VgrepT s m a = VgrepT (StateT s (StateT Environment m) a)
                deriving ( a -> VgrepT s m b -> VgrepT s m a
(a -> b) -> VgrepT s m a -> VgrepT s m b
(forall a b. (a -> b) -> VgrepT s m a -> VgrepT s m b)
-> (forall a b. a -> VgrepT s m b -> VgrepT s m a)
-> Functor (VgrepT s m)
forall a b. a -> VgrepT s m b -> VgrepT s m a
forall a b. (a -> b) -> VgrepT s m a -> VgrepT s m b
forall s (m :: * -> *) a b.
Functor m =>
a -> VgrepT s m b -> VgrepT s m a
forall s (m :: * -> *) a b.
Functor m =>
(a -> b) -> VgrepT s m a -> VgrepT s m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> VgrepT s m b -> VgrepT s m a
$c<$ :: forall s (m :: * -> *) a b.
Functor m =>
a -> VgrepT s m b -> VgrepT s m a
fmap :: (a -> b) -> VgrepT s m a -> VgrepT s m b
$cfmap :: forall s (m :: * -> *) a b.
Functor m =>
(a -> b) -> VgrepT s m a -> VgrepT s m b
Functor
                         , Functor (VgrepT s m)
a -> VgrepT s m a
Functor (VgrepT s m)
-> (forall a. a -> VgrepT s m a)
-> (forall a b.
    VgrepT s m (a -> b) -> VgrepT s m a -> VgrepT s m b)
-> (forall a b c.
    (a -> b -> c) -> VgrepT s m a -> VgrepT s m b -> VgrepT s m c)
-> (forall a b. VgrepT s m a -> VgrepT s m b -> VgrepT s m b)
-> (forall a b. VgrepT s m a -> VgrepT s m b -> VgrepT s m a)
-> Applicative (VgrepT s m)
VgrepT s m a -> VgrepT s m b -> VgrepT s m b
VgrepT s m a -> VgrepT s m b -> VgrepT s m a
VgrepT s m (a -> b) -> VgrepT s m a -> VgrepT s m b
(a -> b -> c) -> VgrepT s m a -> VgrepT s m b -> VgrepT s m c
forall a. a -> VgrepT s m a
forall a b. VgrepT s m a -> VgrepT s m b -> VgrepT s m a
forall a b. VgrepT s m a -> VgrepT s m b -> VgrepT s m b
forall a b. VgrepT s m (a -> b) -> VgrepT s m a -> VgrepT s m b
forall a b c.
(a -> b -> c) -> VgrepT s m a -> VgrepT s m b -> VgrepT s m c
forall s (m :: * -> *). Monad m => Functor (VgrepT s m)
forall s (m :: * -> *) a. Monad m => a -> VgrepT s m a
forall s (m :: * -> *) a b.
Monad m =>
VgrepT s m a -> VgrepT s m b -> VgrepT s m a
forall s (m :: * -> *) a b.
Monad m =>
VgrepT s m a -> VgrepT s m b -> VgrepT s m b
forall s (m :: * -> *) a b.
Monad m =>
VgrepT s m (a -> b) -> VgrepT s m a -> VgrepT s m b
forall s (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> VgrepT s m a -> VgrepT s m b -> VgrepT s m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: VgrepT s m a -> VgrepT s m b -> VgrepT s m a
$c<* :: forall s (m :: * -> *) a b.
Monad m =>
VgrepT s m a -> VgrepT s m b -> VgrepT s m a
*> :: VgrepT s m a -> VgrepT s m b -> VgrepT s m b
$c*> :: forall s (m :: * -> *) a b.
Monad m =>
VgrepT s m a -> VgrepT s m b -> VgrepT s m b
liftA2 :: (a -> b -> c) -> VgrepT s m a -> VgrepT s m b -> VgrepT s m c
$cliftA2 :: forall s (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> VgrepT s m a -> VgrepT s m b -> VgrepT s m c
<*> :: VgrepT s m (a -> b) -> VgrepT s m a -> VgrepT s m b
$c<*> :: forall s (m :: * -> *) a b.
Monad m =>
VgrepT s m (a -> b) -> VgrepT s m a -> VgrepT s m b
pure :: a -> VgrepT s m a
$cpure :: forall s (m :: * -> *) a. Monad m => a -> VgrepT s m a
$cp1Applicative :: forall s (m :: * -> *). Monad m => Functor (VgrepT s m)
Applicative
                         , Applicative (VgrepT s m)
a -> VgrepT s m a
Applicative (VgrepT s m)
-> (forall a b.
    VgrepT s m a -> (a -> VgrepT s m b) -> VgrepT s m b)
-> (forall a b. VgrepT s m a -> VgrepT s m b -> VgrepT s m b)
-> (forall a. a -> VgrepT s m a)
-> Monad (VgrepT s m)
VgrepT s m a -> (a -> VgrepT s m b) -> VgrepT s m b
VgrepT s m a -> VgrepT s m b -> VgrepT s m b
forall a. a -> VgrepT s m a
forall a b. VgrepT s m a -> VgrepT s m b -> VgrepT s m b
forall a b. VgrepT s m a -> (a -> VgrepT s m b) -> VgrepT s m b
forall s (m :: * -> *). Monad m => Applicative (VgrepT s m)
forall s (m :: * -> *) a. Monad m => a -> VgrepT s m a
forall s (m :: * -> *) a b.
Monad m =>
VgrepT s m a -> VgrepT s m b -> VgrepT s m b
forall s (m :: * -> *) a b.
Monad m =>
VgrepT s m a -> (a -> VgrepT s m b) -> VgrepT s m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> VgrepT s m a
$creturn :: forall s (m :: * -> *) a. Monad m => a -> VgrepT s m a
>> :: VgrepT s m a -> VgrepT s m b -> VgrepT s m b
$c>> :: forall s (m :: * -> *) a b.
Monad m =>
VgrepT s m a -> VgrepT s m b -> VgrepT s m b
>>= :: VgrepT s m a -> (a -> VgrepT s m b) -> VgrepT s m b
$c>>= :: forall s (m :: * -> *) a b.
Monad m =>
VgrepT s m a -> (a -> VgrepT s m b) -> VgrepT s m b
$cp1Monad :: forall s (m :: * -> *). Monad m => Applicative (VgrepT s m)
Monad
                         , Monad (VgrepT s m)
Monad (VgrepT s m)
-> (forall a. IO a -> VgrepT s m a) -> MonadIO (VgrepT s m)
IO a -> VgrepT s m a
forall a. IO a -> VgrepT s m a
forall s (m :: * -> *). MonadIO m => Monad (VgrepT s m)
forall s (m :: * -> *) a. MonadIO m => IO a -> VgrepT s m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> VgrepT s m a
$cliftIO :: forall s (m :: * -> *) a. MonadIO m => IO a -> VgrepT s m a
$cp1MonadIO :: forall s (m :: * -> *). MonadIO m => Monad (VgrepT s m)
MonadIO )

-- | 'VgrepT' can read from the 'Environment'. Modifications to the
-- enviromnent are only possible globally (see 'modifyEnvironment'), the
-- 'local' environment is pure.
instance Monad m => MonadReader Environment (VgrepT s m) where
    ask :: VgrepT s m Environment
ask = StateT s (StateT Environment m) Environment
-> VgrepT s m Environment
forall s (m :: * -> *) a.
StateT s (StateT Environment m) a -> VgrepT s m a
VgrepT (StateT Environment m Environment
-> StateT s (StateT Environment m) Environment
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT Environment m Environment
forall s (m :: * -> *). MonadState s m => m s
get)
    local :: (Environment -> Environment) -> VgrepT s m a -> VgrepT s m a
local Environment -> Environment
f VgrepT s m a
action = (s -> Environment -> m (a, s)) -> VgrepT s m a
forall (m :: * -> *) s a.
Monad m =>
(s -> Environment -> m (a, s)) -> VgrepT s m a
mkVgrepT ((s -> Environment -> m (a, s)) -> VgrepT s m a)
-> (s -> Environment -> m (a, s)) -> VgrepT s m a
forall a b. (a -> b) -> a -> b
$ \s
s Environment
env -> VgrepT s m a -> s -> Environment -> m (a, s)
forall (m :: * -> *) s a.
Monad m =>
VgrepT s m a -> s -> Environment -> m (a, s)
runVgrepT VgrepT s m a
action s
s (Environment -> Environment
f Environment
env)

instance Monad m => MonadState s (VgrepT s m) where
    get :: VgrepT s m s
get = StateT s (StateT Environment m) s -> VgrepT s m s
forall s (m :: * -> *) a.
StateT s (StateT Environment m) a -> VgrepT s m a
VgrepT StateT s (StateT Environment m) s
forall s (m :: * -> *). MonadState s m => m s
get
    put :: s -> VgrepT s m ()
put = StateT s (StateT Environment m) () -> VgrepT s m ()
forall s (m :: * -> *) a.
StateT s (StateT Environment m) a -> VgrepT s m a
VgrepT (StateT s (StateT Environment m) () -> VgrepT s m ())
-> (s -> StateT s (StateT Environment m) ()) -> s -> VgrepT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> StateT s (StateT Environment m) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance MonadTrans (VgrepT s) where
    lift :: m a -> VgrepT s m a
lift = StateT s (StateT Environment m) a -> VgrepT s m a
forall s (m :: * -> *) a.
StateT s (StateT Environment m) a -> VgrepT s m a
VgrepT (StateT s (StateT Environment m) a -> VgrepT s m a)
-> (m a -> StateT s (StateT Environment m) a)
-> m a
-> VgrepT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Environment m a -> StateT s (StateT Environment m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Environment m a -> StateT s (StateT Environment m) a)
-> (m a -> StateT Environment m a)
-> m a
-> StateT s (StateT Environment m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT Environment m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MFunctor (VgrepT s) where
    hoist :: (forall a. m a -> n a) -> VgrepT s m b -> VgrepT s n b
hoist forall a. m a -> n a
f (VgrepT StateT s (StateT Environment m) b
action) = StateT s (StateT Environment n) b -> VgrepT s n b
forall s (m :: * -> *) a.
StateT s (StateT Environment m) a -> VgrepT s m a
VgrepT ((forall a. StateT Environment m a -> StateT Environment n a)
-> StateT s (StateT Environment m) b
-> StateT s (StateT Environment n) b
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. m a -> n a)
-> StateT Environment m a -> StateT Environment n a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
f) StateT s (StateT Environment m) b
action)

type instance Zoomed (VgrepT s m) = Zoomed (StateT s (StateT Environment m))

instance Monad m => Zoom (VgrepT s m) (VgrepT t m) s t where
    zoom :: LensLike' (Zoomed (VgrepT s m) c) t s
-> VgrepT s m c -> VgrepT t m c
zoom LensLike' (Zoomed (VgrepT s m) c) t s
l (VgrepT StateT s (StateT Environment m) c
m) = StateT t (StateT Environment m) c -> VgrepT t m c
forall s (m :: * -> *) a.
StateT s (StateT Environment m) a -> VgrepT s m a
VgrepT (LensLike' (Zoomed (StateT s (StateT Environment m)) c) t s
-> StateT s (StateT Environment m) c
-> StateT t (StateT Environment m) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (StateT s (StateT Environment m)) c) t s
LensLike' (Zoomed (VgrepT s m) c) t s
l StateT s (StateT Environment m) c
m)

-- | Lift a monadic action to 'VgrepT'.
mkVgrepT
    :: Monad m
    => (s -> Environment -> m (a, s))
    -> VgrepT s m a
mkVgrepT :: (s -> Environment -> m (a, s)) -> VgrepT s m a
mkVgrepT s -> Environment -> m (a, s)
action =
    let action' :: s -> Environment -> m ((a, s), Environment)
action' s
s Environment
env = ((a, s) -> ((a, s), Environment))
-> m (a, s) -> m ((a, s), Environment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Environment
env) (s -> Environment -> m (a, s)
action s
s Environment
env)
    in  StateT s (StateT Environment m) a -> VgrepT s m a
forall s (m :: * -> *) a.
StateT s (StateT Environment m) a -> VgrepT s m a
VgrepT ((s -> StateT Environment m (a, s))
-> StateT s (StateT Environment m) a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Environment -> m ((a, s), Environment))
-> StateT Environment m (a, s)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Environment -> m ((a, s), Environment))
 -> StateT Environment m (a, s))
-> (s -> Environment -> m ((a, s), Environment))
-> s
-> StateT Environment m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Environment -> m ((a, s), Environment)
action'))

-- | Pass an initial state and an 'Environment' and reduce a 'VgrepT'
-- action to an action in the base monad.
runVgrepT
    :: Monad m
    => VgrepT s m a
    -> s
    -> Environment
    -> m (a, s)
runVgrepT :: VgrepT s m a -> s -> Environment -> m (a, s)
runVgrepT (VgrepT StateT s (StateT Environment m) a
action) s
s Environment
env = do
    ((a
a, s
s'), Environment
_env') <- StateT Environment m (a, s)
-> Environment -> m ((a, s), Environment)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT s (StateT Environment m) a
-> s -> StateT Environment m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s (StateT Environment m) a
action s
s) Environment
env
    (a, s) -> m (a, s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, s
s')

type Vgrep s = VgrepT s Identity


-- | A version of 'E.bracket' where the action is lifted to 'VgrepT'.
vgrepBracket
    :: IO a
    -> (a -> IO c)
    -> (a -> VgrepT s IO b)
    -> VgrepT s IO b
vgrepBracket :: IO a -> (a -> IO c) -> (a -> VgrepT s IO b) -> VgrepT s IO b
vgrepBracket IO a
before a -> IO c
after a -> VgrepT s IO b
action = (s -> Environment -> IO (b, s)) -> VgrepT s IO b
forall (m :: * -> *) s a.
Monad m =>
(s -> Environment -> m (a, s)) -> VgrepT s m a
mkVgrepT ((s -> Environment -> IO (b, s)) -> VgrepT s IO b)
-> (s -> Environment -> IO (b, s)) -> VgrepT s IO b
forall a b. (a -> b) -> a -> b
$ \s
s Environment
env ->
    let baseAction :: a -> IO (b, s)
baseAction a
a = VgrepT s IO b -> s -> Environment -> IO (b, s)
forall (m :: * -> *) s a.
Monad m =>
VgrepT s m a -> s -> Environment -> m (a, s)
runVgrepT (a -> VgrepT s IO b
action a
a) s
s Environment
env
    in  IO a -> (a -> IO c) -> (a -> IO (b, s)) -> IO (b, s)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket IO a
before a -> IO c
after a -> IO (b, s)
baseAction


-- | The 'Environment' of 'VgrepT' is not stateful, however it can be
-- modified globally. An example is resizing the application by changing
-- the display bounds.
modifyEnvironment :: Monad m => (Environment -> Environment) -> VgrepT s m ()
modifyEnvironment :: (Environment -> Environment) -> VgrepT s m ()
modifyEnvironment = StateT s (StateT Environment m) () -> VgrepT s m ()
forall s (m :: * -> *) a.
StateT s (StateT Environment m) a -> VgrepT s m a
VgrepT (StateT s (StateT Environment m) () -> VgrepT s m ())
-> ((Environment -> Environment)
    -> StateT s (StateT Environment m) ())
-> (Environment -> Environment)
-> VgrepT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Environment m () -> StateT s (StateT Environment m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Environment m () -> StateT s (StateT Environment m) ())
-> ((Environment -> Environment) -> StateT Environment m ())
-> (Environment -> Environment)
-> StateT s (StateT Environment m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Environment -> Environment) -> StateT Environment m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify