{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
module Dep.Advice.Basic
(
returnMempty,
printArgs,
SA.AnyEq (..),
doCachingBadly,
doAsyncBadly,
injectFailures,
doLocally,
SA.MethodName,
SA.StackFrame,
SA.SyntheticCallStack,
SA.HasSyntheticCallStack (..),
SA.SyntheticStackTrace,
SA.SyntheticStackTraceException (..),
SA.MonadCallStack (..),
keepCallStack
)
where
import Dep.Advice
import qualified Dep.SimpleAdvice.Basic as SA
import Control.Monad.Dep
import Data.Proxy
import Data.SOP
import Data.SOP (hctraverse_)
import Data.SOP.NP
import Data.Type.Equality
import System.IO
import Type.Reflection
import Control.Concurrent
import Control.Monad.IO.Unlift
import Control.Exception
import qualified Data.Typeable as T
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NonEmpty
import qualified Dep.SimpleAdvice.Basic as SA
import Data.IORef
doLocally :: forall ca e_ m r. Monad m => (e_ (DepT e_ m) -> e_ (DepT e_ m)) -> Advice ca e_ m r
doLocally :: (e_ (DepT e_ m) -> e_ (DepT e_ m)) -> Advice ca e_ m r
doLocally e_ (DepT e_ m) -> e_ (DepT e_ m)
transform = (DepT e_ m r -> DepT e_ m r) -> Advice ca e_ m r
forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Applicative m =>
(DepT e_ m r -> DepT e_ m r) -> Advice ca e_ m r
makeExecutionAdvice ((e_ (DepT e_ m) -> e_ (DepT e_ m)) -> DepT e_ m r -> DepT e_ m r
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local e_ (DepT e_ m) -> e_ (DepT e_ m)
transform)
returnMempty :: forall ca e_ m r. (Monad m, Monoid r) => Advice ca e_ m r
returnMempty :: Advice ca e_ m r
returnMempty = Advice ca (DepT e_ m) r -> Advice ca e_ m r
forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ Advice ca (DepT e_ m) r
forall (ca :: * -> Constraint) (m :: * -> *) r.
(Monad m, Monoid r) =>
Advice ca m r
SA.returnMempty
printArgs :: forall e_ m r. (Monad m, MonadIO (DepT e_ m)) => Handle -> String -> Advice Show e_ m r
printArgs :: Handle -> String -> Advice Show e_ m r
printArgs Handle
h String
prefix = Advice Show (DepT e_ m) r -> Advice Show e_ m r
forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ (Handle -> String -> Advice Show (DepT e_ m) r
forall (m :: * -> *) r.
MonadIO m =>
Handle -> String -> Advice Show m r
SA.printArgs Handle
h String
prefix)
doCachingBadly :: forall e_ m r. Monad m => (SA.AnyEq -> DepT e_ m (Maybe r)) -> (SA.AnyEq -> r -> DepT e_ m ()) -> Advice (Eq `And` Typeable) e_ m r
doCachingBadly :: (AnyEq -> DepT e_ m (Maybe r))
-> (AnyEq -> r -> DepT e_ m ()) -> Advice (And Eq Typeable) e_ m r
doCachingBadly AnyEq -> DepT e_ m (Maybe r)
cacheLookup AnyEq -> r -> DepT e_ m ()
cachePut = Advice (And Eq Typeable) (DepT e_ m) r
-> Advice (And Eq Typeable) e_ m r
forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ ((AnyEq -> DepT e_ m (Maybe r))
-> (AnyEq -> r -> DepT e_ m ())
-> Advice (And Eq Typeable) (DepT e_ m) r
forall (m :: * -> *) r.
Monad m =>
(AnyEq -> m (Maybe r))
-> (AnyEq -> r -> m ()) -> Advice (And Eq Typeable) m r
SA.doCachingBadly AnyEq -> DepT e_ m (Maybe r)
cacheLookup AnyEq -> r -> DepT e_ m ()
cachePut)
doAsyncBadly :: forall ca e_ m . (Monad m, MonadUnliftIO (DepT e_ m)) => Advice ca e_ m ()
doAsyncBadly :: Advice ca e_ m ()
doAsyncBadly = Advice ca (DepT e_ m) () -> Advice ca e_ m ()
forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ Advice ca (DepT e_ m) ()
forall (ca :: * -> Constraint) (m :: * -> *).
MonadUnliftIO m =>
Advice ca m ()
SA.doAsyncBadly
injectFailures :: forall ca e_ m r . (Monad m, MonadIO (DepT e_ m), MonadFail (DepT e_ m)) => IORef ([IO ()], [IO ()]) -> Advice ca e_ m r
injectFailures :: IORef ([IO ()], [IO ()]) -> Advice ca e_ m r
injectFailures IORef ([IO ()], [IO ()])
ref = Advice ca (DepT e_ m) r -> Advice ca e_ m r
forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ (IORef ([IO ()], [IO ()]) -> Advice ca (DepT e_ m) r
forall (ca :: * -> Constraint) (m :: * -> *) r.
(MonadIO m, MonadFail m) =>
IORef ([IO ()], [IO ()]) -> Advice ca m r
SA.injectFailures IORef ([IO ()], [IO ()])
ref)
keepCallStack ::
(Monad m, MonadUnliftIO (DepT e_ m), SA.MonadCallStack (DepT e_ m), Exception e) =>
(SomeException -> Maybe e) ->
NonEmpty (T.TypeRep, SA.MethodName) ->
Advice ca e_ m r
keepCallStack :: (SomeException -> Maybe e)
-> NonEmpty (TypeRep, String) -> Advice ca e_ m r
keepCallStack SomeException -> Maybe e
selector NonEmpty (TypeRep, String)
method = Advice ca (DepT e_ m) r -> Advice ca e_ m r
forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ ((SomeException -> Maybe e)
-> NonEmpty (TypeRep, String) -> Advice ca (DepT e_ m) r
forall (m :: * -> *) e (ca :: * -> Constraint) r.
(MonadUnliftIO m, MonadCallStack m, Exception e) =>
(SomeException -> Maybe e)
-> NonEmpty (TypeRep, String) -> Advice ca m r
SA.keepCallStack SomeException -> Maybe e
selector NonEmpty (TypeRep, String)
method)