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

module Freckle.App.Test
  ( AppExample(..)
  , appExample
  , withApp
  , withAppSql
  , expectationFailure
  , pending
  , pendingWith

  -- * Re-exports
  , 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)

-- | An Hspec example over some @App@ value
--
-- To disable logging in tests, you can either:
--
-- - Export @LOG_LEVEL=error@, if this would be quiet enough, or
-- - Export @LOG_DESTINATION=@/dev/null@ to fully silence
--
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
    )

-- We could derive this in newer versions of unliftio-core, but defining it by
-- hand supports a few resolvers back, without CPP. This is just a copy of the
-- ReaderT instance,
--
-- https://hackage.haskell.org/package/unliftio-core-0.2.0.1/docs/src/Control.Monad.IO.Unlift.html#line-64
--
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
$ ())

-- | A type restricted version of id
--
-- Like 'example', which forces the expectation to 'IO', this can be used to
-- force the expectation to 'AppExample'.
--
-- This can be used to avoid ambiguity errors when your expectation uses only
-- polymorphic functions like 'runDB' or lifted 'shouldBe' et-al.
--
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

-- | 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' if the app 'HasLogger' (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

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