{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}

module Freckle.App.Test
  ( AppExample
  , withApp
  , withAppSql
  , runAppTest
  , module X
  ) where

import Freckle.App.Prelude

import Control.Monad.Base
import Control.Monad.Catch
import qualified Control.Monad.Fail as Fail
import Control.Monad.Logger
import Control.Monad.Primitive
import Control.Monad.Random (MonadRandom(..))
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Data.Pool as X
import Database.Persist.Sql (SqlPersistT, runSqlPool)
import Freckle.App.Database as X
import LoadEnv
import Test.Hspec as X
  (Spec, beforeAll, beforeWith, context, describe, example, fit, it, xit)
import Test.Hspec.Core.Spec (Arg, Example, SpecWith, evaluateExample)
import Test.Hspec.Expectations.Lifted as X

-- | An Hspec example over some @App@ value
newtype AppExample app a = AppExample (NoLoggingT (ReaderT app 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
    , MonadIO (AppExample app)
MonadIO (AppExample app)
-> (forall b.
    ((forall a. AppExample app a -> IO a) -> IO b) -> AppExample app b)
-> MonadUnliftIO (AppExample app)
((forall a. AppExample app a -> IO a) -> IO b) -> AppExample app b
forall app. MonadIO (AppExample app)
forall b.
((forall a. AppExample app a -> IO a) -> IO b) -> AppExample app b
forall app b.
((forall a. AppExample app a -> IO a) -> IO b) -> AppExample app b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: ((forall a. AppExample app a -> IO a) -> IO b) -> AppExample app b
$cwithRunInIO :: forall app b.
((forall a. AppExample app a -> IO a) -> IO b) -> AppExample app b
$cp1MonadUnliftIO :: forall app. MonadIO (AppExample app)
MonadUnliftIO
    , 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 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 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 NoLoggingT (ReaderT app 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
$ ReaderT app IO a -> app -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (NoLoggingT (ReaderT app IO) a -> ReaderT app IO a
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT NoLoggingT (ReaderT app IO) a
ex) app
Arg (AppExample app a)
app)
    Params
params
    ((() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ())

-- | Spec before helper
--
-- @
-- spec :: Spec
-- spec = 'withApp' loadApp $ do
-- @
--
-- Reads @.env.test@, then @.env@, then loads the application. Examples within
-- this spec can use 'runAppTest' (and 'runDB', if the app 'HasSqlPool').
--
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)

-- | 'withApp', with custom DB 'Pool' initialization
--
-- Runs the given function on the pool before every spec item. For example, to
-- truncate tables.
--
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

-- | Run an action with the test @App@
--
-- Like @'runApp'@, but without exception handling or logging
--
runAppTest :: ReaderT app (LoggingT IO) a -> AppExample app a
runAppTest :: ReaderT app (LoggingT IO) a -> AppExample app a
runAppTest ReaderT app (LoggingT IO) a
action = do
  app
app <- AppExample app app
forall r (m :: * -> *). MonadReader r m => m r
ask

  IO a -> AppExample app a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> AppExample app a) -> IO a -> AppExample app a
forall a b. (a -> b) -> a -> b
$ LoggingT IO a -> IO a
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStderrLoggingT (LoggingT IO a -> IO a) -> LoggingT IO a -> IO a
forall a b. (a -> b) -> a -> b
$ (LogSource -> LogLevel -> Bool) -> LoggingT IO a -> LoggingT IO a
forall (m :: * -> *) a.
(LogSource -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
filterLogger (\LogSource
_ LogLevel
_ -> Bool
False) (LoggingT IO a -> LoggingT IO a) -> LoggingT IO a -> LoggingT 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
action
    app
app