{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Test.Polysemy.Mock
( Mock (..),
runMock,
evalMock,
execMock,
MockMany (..),
MocksExist,
MockChain,
MockImpls,
(:++:),
)
where
import Data.Kind
import GHC.Stack (HasCallStack)
import Polysemy
import Polysemy.State
class Mock (eff :: Effect) (m :: Type -> Type) where
data MockImpl eff m :: Effect
data MockState eff m
initialMockState :: MockState eff m
mock :: Member (MockImpl eff m) r => Sem (eff ': r) a -> Sem r a
mockToState :: (Member (Embed m) r, HasCallStack) => Sem (MockImpl eff m ': r) a -> Sem (State (MockState eff m) ': r) a
runMock :: (Mock eff m, Member (Embed m) r, HasCallStack) => Sem (MockImpl eff m ': r) a -> Sem r (MockState eff m, a)
runMock :: forall (eff :: Effect) (m :: * -> *) (r :: EffectRow) a.
(Mock eff m, Member (Embed m) r, HasCallStack) =>
Sem (MockImpl eff m : r) a -> Sem r (MockState eff m, a)
runMock = forall s (r :: EffectRow) a.
s -> Sem (State s : r) a -> Sem r (s, a)
runState forall (eff :: Effect) (m :: * -> *). Mock eff m => MockState eff m
initialMockState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (eff :: Effect) (m :: * -> *) (r :: EffectRow) a.
(Mock eff m, Member (Embed m) r, HasCallStack) =>
Sem (MockImpl eff m : r) a -> Sem (State (MockState eff m) : r) a
mockToState
evalMock :: (Mock eff m, Member (Embed m) r, HasCallStack) => Sem (MockImpl eff m ': r) a -> Sem r a
evalMock :: forall (eff :: Effect) (m :: * -> *) (r :: EffectRow) a.
(Mock eff m, Member (Embed m) r, HasCallStack) =>
Sem (MockImpl eff m : r) a -> Sem r a
evalMock = forall s (r :: EffectRow) a. s -> Sem (State s : r) a -> Sem r a
evalState forall (eff :: Effect) (m :: * -> *). Mock eff m => MockState eff m
initialMockState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (eff :: Effect) (m :: * -> *) (r :: EffectRow) a.
(Mock eff m, Member (Embed m) r, HasCallStack) =>
Sem (MockImpl eff m : r) a -> Sem (State (MockState eff m) : r) a
mockToState
execMock :: (Mock eff m, Member (Embed m) r, HasCallStack) => Sem (MockImpl eff m ': r) a -> Sem r (MockState eff m)
execMock :: forall (eff :: Effect) (m :: * -> *) (r :: EffectRow) a.
(Mock eff m, Member (Embed m) r, HasCallStack) =>
Sem (MockImpl eff m : r) a -> Sem r (MockState eff m)
execMock = forall s (r :: EffectRow) a. s -> Sem (State s : r) a -> Sem r s
execState forall (eff :: Effect) (m :: * -> *). Mock eff m => MockState eff m
initialMockState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (eff :: Effect) (m :: * -> *) (r :: EffectRow) a.
(Mock eff m, Member (Embed m) r, HasCallStack) =>
Sem (MockImpl eff m : r) a -> Sem (State (MockState eff m) : r) a
mockToState
class MockMany (effs :: EffectRow) m (r :: EffectRow) where
mockMany :: MockChain effs m r => Sem (effs :++: r) a -> Sem r a
evalMocks :: (MocksExist effs m, Member (Embed m) r, HasCallStack) => Sem (MockImpls effs m :++: r) a -> Sem r a
instance MockMany '[] r m where
mockMany :: forall a. MockChain '[] r m => Sem ('[] :++: m) a -> Sem m a
mockMany = forall a. a -> a
id
evalMocks :: forall a.
(MocksExist '[] r, Member (Embed r) m, HasCallStack) =>
Sem (MockImpls '[] r :++: m) a -> Sem m a
evalMocks = forall a. a -> a
id
instance (MockMany effs m r, Member (Embed m) (MockImpls effs m :++: r)) => MockMany (eff ': effs) m r where
mockMany :: forall a.
MockChain (eff : effs) m r =>
Sem ((eff : effs) :++: r) a -> Sem r a
mockMany = forall (effs :: EffectRow) (m :: * -> *) (r :: EffectRow) a.
(MockMany effs m r, MockChain effs m r) =>
Sem (effs :++: r) a -> Sem r a
mockMany @effs @m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (eff :: Effect) (m :: * -> *) (r :: EffectRow) a.
(Mock eff m, Member (MockImpl eff m) r) =>
Sem (eff : r) a -> Sem r a
mock @eff @m
evalMocks :: forall a.
(MocksExist (eff : effs) m, Member (Embed m) r, HasCallStack) =>
Sem (MockImpls (eff : effs) m :++: r) a -> Sem r a
evalMocks = forall (effs :: EffectRow) (m :: * -> *) (r :: EffectRow) a.
(MockMany effs m r, MocksExist effs m, Member (Embed m) r,
HasCallStack) =>
Sem (MockImpls effs m :++: r) a -> Sem r a
evalMocks @effs @m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (eff :: Effect) (m :: * -> *) (r :: EffectRow) a.
(Mock eff m, Member (Embed m) r, HasCallStack) =>
Sem (MockImpl eff m : r) a -> Sem r a
evalMock @eff
type family MockChain (xs :: EffectRow) m (r :: EffectRow) :: Constraint where
MockChain '[] r m = ()
MockChain (x ': xs) m r = (Mock x m, Member (MockImpl x m) (xs :++: r), MockChain xs m r)
type family (xs :: [a]) :++: r :: [a] where
'[] :++: r = r
(x ': xs) :++: r = x ': (xs :++: r)
type family MocksExist (xs :: EffectRow) m :: Constraint where
MocksExist '[] _ = ()
MocksExist (x ': xs) m = (Mock x m, MocksExist xs m)
type family MockImpls (xs :: EffectRow) m where
MockImpls '[] _ = '[]
MockImpls (x ': xs) m = MockImpl x m ': MockImpls xs m