{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Freckle.App.Test
( AppExample(..)
, appExample
, withApp
, withAppSql
, expectationFailure
, pending
, pendingWith
, module X
) where
import Freckle.App.Prelude as X
import Data.Pool as X
import Freckle.App.Database as X
import Test.Hspec as X
( Expectation
, Spec
, beforeAll
, beforeWith
, context
, describe
, example
, fit
, it
, xit
)
import Test.Hspec.Expectations.Lifted as X hiding (expectationFailure)
import Blammo.Logging
import Control.Monad.Base
import Control.Monad.Catch
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Unlift (MonadUnliftIO(..))
import Control.Monad.Primitive
import Control.Monad.Random (MonadRandom(..))
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Database.Persist.Sql (SqlPersistT, runSqlPool)
import LoadEnv
import qualified Test.Hspec as Hspec hiding (expectationFailure)
import Test.Hspec.Core.Spec (Arg, Example, SpecWith, evaluateExample)
import qualified Test.Hspec.Expectations.Lifted as Hspec (expectationFailure)
newtype AppExample app a = AppExample
{ AppExample app a -> ReaderT app (LoggingT IO) a
unAppExample :: ReaderT app (LoggingT IO) a
}
deriving newtype
( Functor (AppExample app)
a -> AppExample app a
Functor (AppExample app)
-> (forall a. a -> AppExample app a)
-> (forall a b.
AppExample app (a -> b) -> AppExample app a -> AppExample app b)
-> (forall a b c.
(a -> b -> c)
-> AppExample app a -> AppExample app b -> AppExample app c)
-> (forall a b.
AppExample app a -> AppExample app b -> AppExample app b)
-> (forall a b.
AppExample app a -> AppExample app b -> AppExample app a)
-> Applicative (AppExample app)
AppExample app a -> AppExample app b -> AppExample app b
AppExample app a -> AppExample app b -> AppExample app a
AppExample app (a -> b) -> AppExample app a -> AppExample app b
(a -> b -> c)
-> AppExample app a -> AppExample app b -> AppExample app c
forall app. Functor (AppExample app)
forall a. a -> AppExample app a
forall app a. a -> AppExample app a
forall a b.
AppExample app a -> AppExample app b -> AppExample app a
forall a b.
AppExample app a -> AppExample app b -> AppExample app b
forall a b.
AppExample app (a -> b) -> AppExample app a -> AppExample app b
forall app a b.
AppExample app a -> AppExample app b -> AppExample app a
forall app a b.
AppExample app a -> AppExample app b -> AppExample app b
forall app a b.
AppExample app (a -> b) -> AppExample app a -> AppExample app b
forall a b c.
(a -> b -> c)
-> AppExample app a -> AppExample app b -> AppExample app c
forall app a b c.
(a -> b -> c)
-> AppExample app a -> AppExample app b -> AppExample app 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
<* :: AppExample app a -> AppExample app b -> AppExample app a
$c<* :: forall app a b.
AppExample app a -> AppExample app b -> AppExample app a
*> :: AppExample app a -> AppExample app b -> AppExample app b
$c*> :: forall app a b.
AppExample app a -> AppExample app b -> AppExample app b
liftA2 :: (a -> b -> c)
-> AppExample app a -> AppExample app b -> AppExample app c
$cliftA2 :: forall app a b c.
(a -> b -> c)
-> AppExample app a -> AppExample app b -> AppExample app c
<*> :: AppExample app (a -> b) -> AppExample app a -> AppExample app b
$c<*> :: forall app a b.
AppExample app (a -> b) -> AppExample app a -> AppExample app b
pure :: a -> AppExample app a
$cpure :: forall app a. a -> AppExample app a
$cp1Applicative :: forall app. Functor (AppExample app)
Applicative
, a -> AppExample app b -> AppExample app a
(a -> b) -> AppExample app a -> AppExample app b
(forall a b. (a -> b) -> AppExample app a -> AppExample app b)
-> (forall a b. a -> AppExample app b -> AppExample app a)
-> Functor (AppExample app)
forall a b. a -> AppExample app b -> AppExample app a
forall a b. (a -> b) -> AppExample app a -> AppExample app b
forall app a b. a -> AppExample app b -> AppExample app a
forall app a b. (a -> b) -> AppExample app a -> AppExample app b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AppExample app b -> AppExample app a
$c<$ :: forall app a b. a -> AppExample app b -> AppExample app a
fmap :: (a -> b) -> AppExample app a -> AppExample app b
$cfmap :: forall app a b. (a -> b) -> AppExample app a -> AppExample app b
Functor
, Applicative (AppExample app)
a -> AppExample app a
Applicative (AppExample app)
-> (forall a b.
AppExample app a -> (a -> AppExample app b) -> AppExample app b)
-> (forall a b.
AppExample app a -> AppExample app b -> AppExample app b)
-> (forall a. a -> AppExample app a)
-> Monad (AppExample app)
AppExample app a -> (a -> AppExample app b) -> AppExample app b
AppExample app a -> AppExample app b -> AppExample app b
forall app. Applicative (AppExample app)
forall a. a -> AppExample app a
forall app a. a -> AppExample app a
forall a b.
AppExample app a -> AppExample app b -> AppExample app b
forall a b.
AppExample app a -> (a -> AppExample app b) -> AppExample app b
forall app a b.
AppExample app a -> AppExample app b -> AppExample app b
forall app a b.
AppExample app a -> (a -> AppExample app b) -> AppExample app 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 -> AppExample app a
$creturn :: forall app a. a -> AppExample app a
>> :: AppExample app a -> AppExample app b -> AppExample app b
$c>> :: forall app a b.
AppExample app a -> AppExample app b -> AppExample app b
>>= :: AppExample app a -> (a -> AppExample app b) -> AppExample app b
$c>>= :: forall app a b.
AppExample app a -> (a -> AppExample app b) -> AppExample app b
$cp1Monad :: forall app. Applicative (AppExample app)
Monad
, MonadBase IO
, MonadBaseControl IO
, MonadThrow (AppExample app)
MonadThrow (AppExample app)
-> (forall e a.
Exception e =>
AppExample app a -> (e -> AppExample app a) -> AppExample app a)
-> MonadCatch (AppExample app)
AppExample app a -> (e -> AppExample app a) -> AppExample app a
forall app. MonadThrow (AppExample app)
forall e a.
Exception e =>
AppExample app a -> (e -> AppExample app a) -> AppExample app a
forall app e a.
Exception e =>
AppExample app a -> (e -> AppExample app a) -> AppExample app a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: AppExample app a -> (e -> AppExample app a) -> AppExample app a
$ccatch :: forall app e a.
Exception e =>
AppExample app a -> (e -> AppExample app a) -> AppExample app a
$cp1MonadCatch :: forall app. MonadThrow (AppExample app)
MonadCatch
, Monad (AppExample app)
Monad (AppExample app)
-> (forall a. IO a -> AppExample app a) -> MonadIO (AppExample app)
IO a -> AppExample app a
forall app. Monad (AppExample app)
forall a. IO a -> AppExample app a
forall app α. IO α -> AppExample app α
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> AppExample app a
$cliftIO :: forall app α. IO α -> AppExample app α
$cp1MonadIO :: forall app. Monad (AppExample app)
MonadIO
, MonadReader app
, Monad (AppExample app)
e -> AppExample app a
Monad (AppExample app)
-> (forall e a. Exception e => e -> AppExample app a)
-> MonadThrow (AppExample app)
forall app. Monad (AppExample app)
forall e a. Exception e => e -> AppExample app a
forall app e a. Exception e => e -> AppExample app a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> AppExample app a
$cthrowM :: forall app e a. Exception e => e -> AppExample app a
$cp1MonadThrow :: forall app. Monad (AppExample app)
MonadThrow
, Monad (AppExample app)
Monad (AppExample app)
-> (forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> AppExample app ())
-> MonadLogger (AppExample app)
Loc -> LogSource -> LogLevel -> msg -> AppExample app ()
forall app. Monad (AppExample app)
forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> AppExample app ()
forall app msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> AppExample app ()
forall (m :: * -> *).
Monad m
-> (forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> m ())
-> MonadLogger m
monadLoggerLog :: Loc -> LogSource -> LogLevel -> msg -> AppExample app ()
$cmonadLoggerLog :: forall app msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> AppExample app ()
$cp1MonadLogger :: forall app. Monad (AppExample app)
MonadLogger
, Monad (AppExample app)
Monad (AppExample app)
-> (forall a. String -> AppExample app a)
-> MonadFail (AppExample app)
String -> AppExample app a
forall app. Monad (AppExample app)
forall a. String -> AppExample app a
forall app a. String -> AppExample app a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> AppExample app a
$cfail :: forall app a. String -> AppExample app a
$cp1MonadFail :: forall app. Monad (AppExample app)
Fail.MonadFail
)
instance MonadUnliftIO (AppExample app) where
{-# INLINE withRunInIO #-}
withRunInIO :: ((forall a. AppExample app a -> IO a) -> IO b) -> AppExample app b
withRunInIO (forall a. AppExample app a -> IO a) -> IO b
inner =
ReaderT app (LoggingT IO) b -> AppExample app b
forall app a. ReaderT app (LoggingT IO) a -> AppExample app a
AppExample (ReaderT app (LoggingT IO) b -> AppExample app b)
-> ReaderT app (LoggingT IO) b -> AppExample app b
forall a b. (a -> b) -> a -> b
$ ((forall a. ReaderT app (LoggingT IO) a -> IO a) -> IO b)
-> ReaderT app (LoggingT IO) b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. ReaderT app (LoggingT IO) a -> IO a) -> IO b)
-> ReaderT app (LoggingT IO) b)
-> ((forall a. ReaderT app (LoggingT IO) a -> IO a) -> IO b)
-> ReaderT app (LoggingT IO) b
forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT app (LoggingT IO) a -> IO a
run -> (forall a. AppExample app a -> IO a) -> IO b
inner (ReaderT app (LoggingT IO) a -> IO a
forall a. ReaderT app (LoggingT IO) a -> IO a
run (ReaderT app (LoggingT IO) a -> IO a)
-> (AppExample app a -> ReaderT app (LoggingT IO) a)
-> AppExample app a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppExample app a -> ReaderT app (LoggingT IO) a
forall app a. AppExample app a -> ReaderT app (LoggingT IO) a
unAppExample)
instance MonadRandom (AppExample app) where
getRandomR :: (a, a) -> AppExample app a
getRandomR = IO a -> AppExample app a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> AppExample app a)
-> ((a, a) -> IO a) -> (a, a) -> AppExample app a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> IO a
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR
getRandom :: AppExample app a
getRandom = IO a -> AppExample app a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom
getRandomRs :: (a, a) -> AppExample app [a]
getRandomRs = IO [a] -> AppExample app [a]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [a] -> AppExample app [a])
-> ((a, a) -> IO [a]) -> (a, a) -> AppExample app [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> IO [a]
forall (m :: * -> *) a.
(MonadRandom m, Random a) =>
(a, a) -> m [a]
getRandomRs
getRandoms :: AppExample app [a]
getRandoms = IO [a] -> AppExample app [a]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [a]
forall (m :: * -> *) a. (MonadRandom m, Random a) => m [a]
getRandoms
instance PrimMonad (AppExample app) where
type PrimState (AppExample app) = PrimState IO
primitive :: (State# (PrimState (AppExample app))
-> (# State# (PrimState (AppExample app)), a #))
-> AppExample app a
primitive = IO a -> AppExample app a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> AppExample app a)
-> ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #))
-> AppExample app a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
instance HasLogger app => Example (AppExample app a) where
type Arg (AppExample app a) = app
evaluateExample :: AppExample app a
-> Params
-> (ActionWith (Arg (AppExample app a)) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample (AppExample ReaderT app (LoggingT IO) a
ex) Params
params ActionWith (Arg (AppExample app a)) -> IO ()
action = IO ()
-> Params
-> (ActionWith (Arg (IO ())) -> IO ())
-> ProgressCallback
-> IO Result
forall e.
Example e =>
e
-> Params
-> (ActionWith (Arg e) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample
(ActionWith (Arg (AppExample app a)) -> IO ()
action (ActionWith (Arg (AppExample app a)) -> IO ())
-> ActionWith (Arg (AppExample app a)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Arg (AppExample app a)
app -> IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ app -> LoggingT IO a -> IO a
forall (m :: * -> *) env a.
(MonadIO m, HasLogger env) =>
env -> LoggingT m a -> m a
runLoggerLoggingT app
Arg (AppExample app a)
app (LoggingT IO a -> IO a) -> LoggingT IO a -> IO a
forall a b. (a -> b) -> a -> b
$ ReaderT app (LoggingT IO) a -> app -> LoggingT IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT app (LoggingT IO) a
ex app
Arg (AppExample app a)
app)
Params
params
((() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ())
appExample :: AppExample app a -> AppExample app a
appExample :: AppExample app a -> AppExample app a
appExample = AppExample app a -> AppExample app a
forall a. a -> a
id
withApp :: IO app -> SpecWith app -> Spec
withApp :: IO app -> SpecWith app -> Spec
withApp IO app
load = IO app -> SpecWith app -> Spec
forall a. HasCallStack => IO a -> SpecWith a -> Spec
beforeAll (IO ()
loadEnvTest IO () -> IO app -> IO app
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO app
load)
withAppSql
:: HasSqlPool app => SqlPersistT IO a -> IO app -> SpecWith app -> Spec
withAppSql :: SqlPersistT IO a -> IO app -> SpecWith app -> Spec
withAppSql SqlPersistT IO a
f IO app
load = IO app -> SpecWith app -> Spec
forall a. HasCallStack => IO a -> SpecWith a -> Spec
beforeAll (IO ()
loadEnvTest IO () -> IO app -> IO app
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO app
load) (SpecWith app -> Spec)
-> (SpecWith app -> SpecWith app) -> SpecWith app -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (app -> IO app) -> SpecWith app -> SpecWith app
forall b a. (b -> IO a) -> SpecWith a -> SpecWith b
beforeWith app -> IO app
setup
where setup :: app -> IO app
setup app
app = app
app app -> IO a -> IO app
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SqlPersistT IO a -> Pool SqlBackend -> IO a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> Pool backend -> m a
runSqlPool SqlPersistT IO a
f (app -> Pool SqlBackend
forall app. HasSqlPool app => app -> Pool SqlBackend
getSqlPool app
app)
loadEnvTest :: IO ()
loadEnvTest :: IO ()
loadEnvTest = String -> IO ()
loadEnvFrom String
".env.test" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
loadEnv
expectationFailure :: (HasCallStack, MonadIO m) => String -> m a
expectationFailure :: String -> m a
expectationFailure String
msg = String -> m ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => String -> m ()
Hspec.expectationFailure String
msg m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> m a
forall a. HasCallStack => String -> a
error String
"unreachable"
pending :: MonadIO m => m ()
pending :: m ()
pending = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
HasCallStack => IO ()
Hspec.pending
pendingWith :: MonadIO m => String -> m ()
pendingWith :: String -> m ()
pendingWith String
msg = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> IO ()
String -> IO ()
Hspec.pendingWith String
msg