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

module Freckle.App.Test
  ( AppExample(..)
  , appExample
  , withApp
  , withAppSql
  , beforeSql
  , 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 qualified Freckle.App.Dotenv as Dotenv
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
  { forall app a. AppExample app a -> ReaderT app (LoggingT IO) a
unAppExample :: ReaderT app (LoggingT IO) a
  }
  deriving newtype
    ( 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
<* :: forall a b.
AppExample app a -> AppExample app b -> AppExample app a
$c<* :: forall app a b.
AppExample app a -> AppExample app b -> AppExample app a
*> :: forall a b.
AppExample app a -> AppExample app b -> AppExample app b
$c*> :: forall app a b.
AppExample app a -> AppExample app b -> AppExample app b
liftA2 :: forall a b c.
(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
<*> :: forall a b.
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 :: forall a. a -> AppExample app a
$cpure :: forall app a. a -> AppExample app a
Applicative
    , 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
<$ :: forall a b. a -> AppExample app b -> AppExample app a
$c<$ :: forall app a b. a -> AppExample app b -> AppExample app a
fmap :: forall a b. (a -> b) -> AppExample app a -> AppExample app b
$cfmap :: forall app a b. (a -> b) -> AppExample app a -> AppExample app b
Functor
    , 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 :: forall a. a -> AppExample app a
$creturn :: forall app a. a -> AppExample app a
>> :: forall a b.
AppExample app a -> AppExample app b -> AppExample app b
$c>> :: forall app a b.
AppExample app a -> AppExample app b -> AppExample app b
>>= :: forall a 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
Monad
    , MonadBase IO
    , MonadBaseControl IO
    , 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 :: forall e a.
Exception e =>
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
MonadCatch
    , 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 :: forall a. IO a -> AppExample app a
$cliftIO :: forall app α. IO α -> AppExample app α
MonadIO
    , MonadReader 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 :: forall e a. Exception e => e -> AppExample app a
$cthrowM :: forall app e a. Exception e => e -> AppExample app a
MonadThrow
    , 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 :: forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> AppExample app ()
$cmonadLoggerLog :: forall app msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> AppExample app ()
MonadLogger
    , 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 :: forall a. String -> AppExample app a
$cfail :: forall app a. String -> AppExample app a
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 b.
((forall a. AppExample app a -> IO a) -> IO b) -> AppExample app b
withRunInIO (forall a. AppExample app a -> IO a) -> IO b
inner =
    forall app a. ReaderT app (LoggingT IO) a -> AppExample app a
AppExample forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO 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 (forall a. ReaderT app (LoggingT IO) a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall app a. AppExample app a -> ReaderT app (LoggingT IO) a
unAppExample)

instance MonadRandom (AppExample app) where
  getRandomR :: forall a. Random a => (a, a) -> AppExample app a
getRandomR = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR
  getRandom :: forall a. Random a => AppExample app a
getRandom = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom
  getRandomRs :: forall a. Random a => (a, a) -> AppExample app [a]
getRandomRs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadRandom m, Random a) =>
(a, a) -> m [a]
getRandomRs
  getRandoms :: forall a. Random a => AppExample app [a]
getRandoms = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *) a. (MonadRandom m, Random a) => m [a]
getRandoms

instance PrimMonad (AppExample app) where
  type PrimState (AppExample app) = PrimState IO
  primitive :: forall a.
(State# (PrimState (AppExample app))
 -> (# State# (PrimState (AppExample app)), a #))
-> AppExample app a
primitive = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall e.
Example e =>
e
-> Params
-> (ActionWith (Arg e) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample
    (ActionWith (Arg (AppExample app a)) -> IO ()
action forall a b. (a -> b) -> a -> b
$ \Arg (AppExample app a)
app -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env a.
(MonadUnliftIO m, HasLogger env) =>
env -> LoggingT m a -> m a
runLoggerLoggingT Arg (AppExample app a)
app forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT app (LoggingT IO) a
ex Arg (AppExample app a)
app)
    Params
params
    (forall a b. (a -> b) -> a -> b
$ ())

instance HasVaultData app => HasVaultData (AppExample app a) where
  getVaultData :: AppExample app a -> Maybe XRayVaultData
getVaultData = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall env. HasVaultData env => env -> Maybe XRayVaultData
getVaultData

-- | 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 :: forall app a. AppExample app a -> AppExample app a
appExample = forall a. a -> a
id

-- | Spec before helper
--
-- @
-- spec :: Spec
-- spec = 'withApp' loadApp $ do
-- @
--
-- Reads @.env.test@, then loads the application. Examples within this spec can
-- use any @'MonadReader' app@ (including 'runDB', if the app 'HasSqlPool').
--
withApp :: ((app -> IO ()) -> IO ()) -> SpecWith app -> Spec
withApp :: forall app. ((app -> IO ()) -> IO ()) -> SpecWith app -> Spec
withApp (app -> IO ()) -> IO ()
run = forall a. HasCallStack => IO a -> SpecWith a -> Spec
beforeAll IO ()
Dotenv.loadTest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasCallStack =>
(ActionWith a -> IO ()) -> SpecWith a -> Spec
Hspec.aroundAll (app -> IO ()) -> IO ()
run

-- | '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
  -> ((app -> IO ()) -> IO ())
  -> SpecWith app
  -> Spec
withAppSql :: forall app a.
HasSqlPool app =>
SqlPersistT IO a
-> ((app -> IO ()) -> IO ()) -> SpecWith app -> Spec
withAppSql SqlPersistT IO a
f (app -> IO ()) -> IO ()
run = forall app. ((app -> IO ()) -> IO ()) -> SpecWith app -> Spec
withApp (app -> IO ()) -> IO ()
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall app a.
HasSqlPool app =>
SqlPersistT IO a -> SpecWith app -> SpecWith app
beforeSql SqlPersistT IO a
f
{-# DEPRECATED withAppSql "Replace `withAppSql f g` with `withApp g . beforeSql f`" #-}

-- | Run the given SQL action before every spec item
beforeSql :: HasSqlPool app => SqlPersistT IO a -> SpecWith app -> SpecWith app
beforeSql :: forall app a.
HasSqlPool app =>
SqlPersistT IO a -> SpecWith app -> SpecWith app
beforeSql SqlPersistT IO a
f = forall b a. (b -> IO a) -> SpecWith a -> SpecWith b
beforeWith forall a b. (a -> b) -> a -> b
$ \app
app -> app
app forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> Pool backend -> m a
runSqlPool SqlPersistT IO a
f (forall app. HasSqlPool app => app -> SqlPool
getSqlPool app
app)

expectationFailure :: (HasCallStack, MonadIO m) => String -> m a
expectationFailure :: forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure String
msg = forall (m :: * -> *). (HasCallStack, MonadIO m) => String -> m ()
Hspec.expectationFailure String
msg forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. HasCallStack => String -> a
error String
"unreachable"

pending :: MonadIO m => m ()
pending :: forall (m :: * -> *). MonadIO m => m ()
pending = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO HasCallStack => IO ()
Hspec.pending

pendingWith :: MonadIO m => String -> m ()
pendingWith :: forall (m :: * -> *). MonadIO m => String -> m ()
pendingWith String
msg = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> IO ()
Hspec.pendingWith String
msg