{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Test.Syd.Yesod.Def
  ( yesodSpec,
    yesodSpecWithSiteGenerator,
    yesodSpecWithSiteGeneratorAndArgument,
    yesodSpecWithSiteSupplier,
    yesodSpecWithSiteSupplierWith,
    yesodSpecWithSiteSetupFunc,
    yesodSpecWithSiteSetupFunc',
    yesodClientSetupFunc,
    YesodSpec,
    yit,
    ydescribe,
  )
where

import GHC.Stack (HasCallStack)
import Network.HTTP.Client as HTTP
import Network.URI
import Test.Syd
import Test.Syd.Wai
import Test.Syd.Yesod.Client
import Yesod.Core as Yesod

-- | Run a test suite using the given 'site'.
--
-- If your 'site' contains any resources that need to be set up, you probably want to be using one of the following functions instead.
--
-- Example usage with a minimal yesod 'App':
--
-- > {-# LANGUAGE MultiParamTypeClasses #-}
-- > {-# LANGUAGE OverloadedStrings     #-}
-- > {-# LANGUAGE QuasiQuotes           #-}
-- > {-# LANGUAGE TemplateHaskell       #-}
-- > {-# LANGUAGE TypeFamilies          #-}
-- >
-- > module Minimal where
-- >
-- > import Yesod
-- > import Test.Syd
-- >
-- > data App = App -- | Empty App type
-- >
-- > mkYesod "App" [parseRoutes|
-- >     / HomeR GET
-- > |]
-- >
-- > instance Yesod App
-- >
-- > getHomeR :: Handler Html
-- > getHomeR = "Hello, world!"
-- >
-- > main :: IO ()
-- > main = Yesod.warp 3000 App
-- >
-- > testMain :: IO ()
-- > testMain = sydTest spec
-- >
-- > spec :: Spec
-- > spec = yesodSpec App $ do
-- >   it "returns 200 on the homepage" $ do
-- >     get HomeR
-- >     statusIs 200
--
-- This function exists for backward compatibility with yesod-test.
yesodSpec :: YesodDispatch site => site -> YesodSpec site -> Spec
yesodSpec :: site -> YesodSpec site -> Spec
yesodSpec site
site = IO site -> YesodSpec site -> Spec
forall site.
YesodDispatch site =>
IO site -> YesodSpec site -> Spec
yesodSpecWithSiteGenerator (IO site -> YesodSpec site -> Spec)
-> IO site -> YesodSpec site -> Spec
forall a b. (a -> b) -> a -> b
$ site -> IO site
forall (f :: * -> *) a. Applicative f => a -> f a
pure site
site

-- | Run a test suite using the given 'site' generator.
--
-- If your 'site' contains any resources that you will want to have set up beforhand, you will probably want to use 'yesodSpecWithSiteGeneratorAndArgument' or 'yesodSpecWithSiteSupplierWith' instead.
--
--
-- Example usage with a yesod 'App' that contains a secret key that is generated at startup but not used during tests:
--
-- > data Key = Key -- The implementation of the actual key is omitted here for brevity.
-- > genKey :: IO Key
-- > genKey = pure Key
-- >
-- > data App = App { appSecretKey :: Key }
-- >
-- > genApp :: IO App
-- > genApp = App <$> genKey
-- >
-- > main :: IO ()
-- > main = sydTest spec
-- >
-- > spec :: Spec
-- > spec = yesodSpecWithSiteGenerator genApp $ do
-- >   it "returns 200 on the homepage" $ do
-- >     get HomeR
-- >     statusIs 200
--
-- This function exists for backward compatibility with yesod-test.
yesodSpecWithSiteGenerator :: YesodDispatch site => IO site -> YesodSpec site -> Spec
yesodSpecWithSiteGenerator :: IO site -> YesodSpec site -> Spec
yesodSpecWithSiteGenerator IO site
siteGen = (() -> IO site) -> YesodSpec site -> Spec
forall site a.
YesodDispatch site =>
(a -> IO site) -> YesodSpec site -> SpecWith a
yesodSpecWithSiteGeneratorAndArgument ((() -> IO site) -> YesodSpec site -> Spec)
-> (() -> IO site) -> YesodSpec site -> Spec
forall a b. (a -> b) -> a -> b
$ \() -> IO site
siteGen

-- | Run a test suite using the given 'site' generator which uses an inner resource.
--
-- If your 'site' contains any resources that you need to set up using a 'withX' function, you will want to use `yesodSpecWithSiteSupplier` instead.
--
-- This function exists for backward compatibility with yesod-test.
yesodSpecWithSiteGeneratorAndArgument :: YesodDispatch site => (a -> IO site) -> YesodSpec site -> SpecWith a
yesodSpecWithSiteGeneratorAndArgument :: (a -> IO site) -> YesodSpec site -> SpecWith a
yesodSpecWithSiteGeneratorAndArgument a -> IO site
func = (forall r. (site -> IO r) -> a -> IO r)
-> YesodSpec site -> SpecWith a
forall site inner.
YesodDispatch site =>
(forall r. (site -> IO r) -> inner -> IO r)
-> YesodSpec site -> SpecWith inner
yesodSpecWithSiteSupplierWith ((forall r. (site -> IO r) -> a -> IO r)
 -> YesodSpec site -> SpecWith a)
-> (forall r. (site -> IO r) -> a -> IO r)
-> YesodSpec site
-> SpecWith a
forall a b. (a -> b) -> a -> b
$ \site -> IO r
f a
a -> a -> IO site
func a
a IO site -> (site -> IO r) -> IO r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= site -> IO r
f

-- | Using a function that supplies a 'site', run a test suite.
--
-- Example usage with a yesod 'App' that contains an sqlite database connection. See 'sydtest-persistent-sqlite'.
--
-- > import Test.Syd.Persistent.Sqlite
-- >
-- > data App = App { appConnectionPool :: ConnectionPool }
-- >
-- > main :: IO ()
-- > main = sydTest spec
-- >
-- > appSupplier :: (App -> IO r) -> IO r
-- > appSupplier func =
-- >   withConnectionPool myMigration $ \pool ->
-- >     func $ App { appConnectionPool = pool}
-- >
-- > spec :: Spec
-- > spec = yesodSpecWithSiteSupplier appSupplier $ do
-- >   it "returns 200 on the homepage" $ do
-- >     get HomeR
-- >     statusIs 200
yesodSpecWithSiteSupplier :: YesodDispatch site => (forall r. (site -> IO r) -> IO r) -> YesodSpec site -> Spec
yesodSpecWithSiteSupplier :: (forall r. (site -> IO r) -> IO r) -> YesodSpec site -> Spec
yesodSpecWithSiteSupplier forall r. (site -> IO r) -> IO r
func = (forall r. (site -> IO r) -> () -> IO r) -> YesodSpec site -> Spec
forall site inner.
YesodDispatch site =>
(forall r. (site -> IO r) -> inner -> IO r)
-> YesodSpec site -> SpecWith inner
yesodSpecWithSiteSupplierWith (\site -> IO r
f () -> (site -> IO r) -> IO r
forall r. (site -> IO r) -> IO r
func site -> IO r
f)

-- | Using a function that supplies a 'site', based on an inner resource, run a test suite.
yesodSpecWithSiteSupplierWith :: YesodDispatch site => (forall r. (site -> IO r) -> (inner -> IO r)) -> YesodSpec site -> SpecWith inner
yesodSpecWithSiteSupplierWith :: (forall r. (site -> IO r) -> inner -> IO r)
-> YesodSpec site -> SpecWith inner
yesodSpecWithSiteSupplierWith forall r. (site -> IO r) -> inner -> IO r
func = TestDefM '[Manager] inner () -> SpecWith inner
forall (outers :: [*]) inner result.
TestDefM (Manager : outers) inner result
-> TestDefM outers inner result
managerSpec (TestDefM '[Manager] inner () -> SpecWith inner)
-> (YesodSpec site -> TestDefM '[Manager] inner ())
-> YesodSpec site
-> SpecWith inner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Manager -> inner -> SetupFunc site)
-> YesodSpec site -> TestDefM '[Manager] inner ()
forall site inner (outers :: [*]).
YesodDispatch site =>
(Manager -> inner -> SetupFunc site)
-> TestDef (Manager : outers) (YesodClient site)
-> TestDef (Manager : outers) inner
yesodSpecWithSiteSetupFunc' (\Manager
_ inner
inner -> (forall r. (site -> IO r) -> IO r) -> SetupFunc site
forall resource.
(forall r. (resource -> IO r) -> IO r) -> SetupFunc resource
SetupFunc ((forall r. (site -> IO r) -> IO r) -> SetupFunc site)
-> (forall r. (site -> IO r) -> IO r) -> SetupFunc site
forall a b. (a -> b) -> a -> b
$ \site -> IO r
takeSite -> (site -> IO r) -> inner -> IO r
forall r. (site -> IO r) -> inner -> IO r
func site -> IO r
takeSite inner
inner)

-- | Using a function that supplies a 'site', using a 'SetupFunc'
--
-- This function assumed that you've already set up the 'HTTP.Manager' beforehand using something like 'managerSpec'.
yesodSpecWithSiteSetupFunc ::
  YesodDispatch site =>
  (HTTP.Manager -> SetupFunc site) ->
  TestDef (HTTP.Manager ': outers) (YesodClient site) ->
  TestDef (HTTP.Manager ': outers) ()
yesodSpecWithSiteSetupFunc :: (Manager -> SetupFunc site)
-> TestDef (Manager : outers) (YesodClient site)
-> TestDef (Manager : outers) ()
yesodSpecWithSiteSetupFunc Manager -> SetupFunc site
setupFunc = (Manager -> () -> SetupFunc site)
-> TestDef (Manager : outers) (YesodClient site)
-> TestDef (Manager : outers) ()
forall site inner (outers :: [*]).
YesodDispatch site =>
(Manager -> inner -> SetupFunc site)
-> TestDef (Manager : outers) (YesodClient site)
-> TestDef (Manager : outers) inner
yesodSpecWithSiteSetupFunc' ((Manager -> () -> SetupFunc site)
 -> TestDef (Manager : outers) (YesodClient site)
 -> TestDef (Manager : outers) ())
-> (Manager -> () -> SetupFunc site)
-> TestDef (Manager : outers) (YesodClient site)
-> TestDef (Manager : outers) ()
forall a b. (a -> b) -> a -> b
$ \Manager
man () -> Manager -> SetupFunc site
setupFunc Manager
man

-- | Using a function that supplies a 'site', using a 'SetupFunc'.
--
-- This function assumed that you've already set up the 'HTTP.Manager' beforehand using something like 'managerSpec'.
yesodSpecWithSiteSetupFunc' ::
  YesodDispatch site =>
  (HTTP.Manager -> inner -> SetupFunc site) ->
  TestDef (HTTP.Manager ': outers) (YesodClient site) ->
  TestDef (HTTP.Manager ': outers) inner
yesodSpecWithSiteSetupFunc' :: (Manager -> inner -> SetupFunc site)
-> TestDef (Manager : outers) (YesodClient site)
-> TestDef (Manager : outers) inner
yesodSpecWithSiteSetupFunc' Manager -> inner -> SetupFunc site
setupFunc = (Manager -> inner -> SetupFunc (YesodClient site))
-> TestDef (Manager : outers) (YesodClient site)
-> TestDef (Manager : outers) inner
forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith' ((Manager -> inner -> SetupFunc (YesodClient site))
 -> TestDef (Manager : outers) (YesodClient site)
 -> TestDef (Manager : outers) inner)
-> (Manager -> inner -> SetupFunc (YesodClient site))
-> TestDef (Manager : outers) (YesodClient site)
-> TestDef (Manager : outers) inner
forall a b. (a -> b) -> a -> b
$ \Manager
man inner
inner -> do
  site
site <- Manager -> inner -> SetupFunc site
setupFunc Manager
man inner
inner
  Manager -> site -> SetupFunc (YesodClient site)
forall site.
YesodDispatch site =>
Manager -> site -> SetupFunc (YesodClient site)
yesodClientSetupFunc Manager
man site
site

yesodClientSetupFunc :: YesodDispatch site => HTTP.Manager -> site -> SetupFunc (YesodClient site)
yesodClientSetupFunc :: Manager -> site -> SetupFunc (YesodClient site)
yesodClientSetupFunc Manager
man site
site = do
  Application
application <- IO Application -> SetupFunc Application
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Application -> SetupFunc Application)
-> IO Application -> SetupFunc Application
forall a b. (a -> b) -> a -> b
$ site -> IO Application
forall site. YesodDispatch site => site -> IO Application
Yesod.toWaiAppPlain site
site
  PortNumber
p <- Application -> SetupFunc PortNumber
applicationSetupFunc Application
application
  let client :: YesodClient site
client =
        YesodClient :: forall site. site -> Manager -> URI -> YesodClient site
YesodClient
          { yesodClientManager :: Manager
yesodClientManager = Manager
man,
            yesodClientSite :: site
yesodClientSite = site
site,
            yesodClientSiteURI :: URI
yesodClientSiteURI =
              URI
nullURI
                { uriScheme :: String
uriScheme = String
"http:",
                  uriAuthority :: Maybe URIAuth
uriAuthority =
                    URIAuth -> Maybe URIAuth
forall a. a -> Maybe a
Just (URIAuth -> Maybe URIAuth) -> URIAuth -> Maybe URIAuth
forall a b. (a -> b) -> a -> b
$
                      URIAuth :: String -> String -> String -> URIAuth
URIAuth
                        { uriUserInfo :: String
uriUserInfo = String
"",
                          uriRegName :: String
uriRegName = String
"localhost",
                          uriPort :: String
uriPort = Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: PortNumber -> String
forall a. Show a => a -> String
show PortNumber
p
                        }
                }
          }
  YesodClient site -> SetupFunc (YesodClient site)
forall (f :: * -> *) a. Applicative f => a -> f a
pure YesodClient site
client

-- | For backward compatibility with yesod-test
type YesodSpec site = TestDef '[HTTP.Manager] (YesodClient site)

-- | Define a test in the @YesodClientM site@ monad instead of 'IO'.
--
-- The @YesodClientM site ()@ type is a member of 'IsTest', so 'yit' is defined as 'it'.
-- This function is only here for backward compatibility.
--
-- > yit = it
yit ::
  forall site.
  HasCallStack =>
  String ->
  YesodClientM site () ->
  YesodSpec site
yit :: String -> YesodClientM site () -> YesodSpec site
yit = String -> YesodClientM site () -> YesodSpec site
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it

-- | For compatibility with @yesod-test@
--
-- > ydescribe = describe
ydescribe :: String -> YesodSpec site -> YesodSpec site
ydescribe :: String -> YesodSpec site -> YesodSpec site
ydescribe = String -> YesodSpec site -> YesodSpec site
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe