{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Vgrep.Type
(
VgrepT ()
, Vgrep
, mkVgrepT
, runVgrepT
, modifyEnvironment
, vgrepBracket
, 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
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 )
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)
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'))
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
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
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