{-# 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 :: forall (ca :: * -> Constraint) (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)
transform = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Applicative m =>
(DepT e_ m r -> DepT e_ m r) -> Advice ca e_ m r
makeExecutionAdvice (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 :: forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
(Monad m, Monoid r) =>
Advice ca e_ m r
returnMempty = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ 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 :: forall (e_ :: (* -> *) -> *) (m :: * -> *) r.
(Monad m, MonadIO (DepT e_ m)) =>
Handle -> String -> Advice Show e_ m r
printArgs Handle
h String
prefix = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ (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 :: forall (e_ :: (* -> *) -> *) (m :: * -> *) r.
Monad m =>
(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 = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ (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 :: forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *).
(Monad m, MonadUnliftIO (DepT e_ m)) =>
Advice ca e_ m ()
doAsyncBadly = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ 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 :: forall (ca :: * -> Constraint) (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 ()])
ref = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ (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 :: forall (m :: * -> *) (e_ :: (* -> *) -> *) e
(ca :: * -> Constraint) r.
(Monad m, MonadUnliftIO (DepT e_ m), MonadCallStack (DepT e_ m),
Exception e) =>
(SomeException -> Maybe e)
-> NonEmpty (TypeRep, String) -> Advice ca e_ m r
keepCallStack SomeException -> Maybe e
selector NonEmpty (TypeRep, String)
method = forall (ca :: * -> Constraint) (e_ :: (* -> *) -> *) (m :: * -> *)
r.
Monad m =>
Advice ca (DepT e_ m) r -> Advice ca e_ m r
fromSimple_ (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)