{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints -fno-warn-unused-imports #-}
module Test.Syd.Yesod.Client where
import Control.Monad.Catch
import Control.Monad.Fail
import Control.Monad.Reader
import Control.Monad.State
import qualified Control.Monad.State as State
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LB
import Data.Text (Text)
import qualified Data.Text as T
import Network.HTTP.Client as HTTP
import Network.HTTP.Types as HTTP
import Test.Syd
import Yesod.Core as Yesod
data YesodClient site = YesodClient
{
YesodClient site -> site
yesodClientSite :: !site,
YesodClient site -> Manager
yesodClientManager :: !HTTP.Manager,
YesodClient site -> Int
yesodClientSitePort :: !Int
}
data YesodClientState site = YesodClientState
{
YesodClientState site -> Maybe (Request, Response ByteString)
yesodClientStateLast :: !(Maybe (Request, Response LB.ByteString)),
YesodClientState site -> CookieJar
yesodClientStateCookies :: !CookieJar
}
initYesodClientState :: YesodClientState site
initYesodClientState :: YesodClientState site
initYesodClientState =
YesodClientState :: forall site.
Maybe (Request, Response ByteString)
-> CookieJar -> YesodClientState site
YesodClientState
{ yesodClientStateLast :: Maybe (Request, Response ByteString)
yesodClientStateLast = Maybe (Request, Response ByteString)
forall a. Maybe a
Nothing,
yesodClientStateCookies :: CookieJar
yesodClientStateCookies = [Cookie] -> CookieJar
createCookieJar []
}
newtype YesodClientM site a = YesodClientM
{ YesodClientM site a
-> StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
unYesodClientM :: StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
}
deriving
( a -> YesodClientM site b -> YesodClientM site a
(a -> b) -> YesodClientM site a -> YesodClientM site b
(forall a b.
(a -> b) -> YesodClientM site a -> YesodClientM site b)
-> (forall a b. a -> YesodClientM site b -> YesodClientM site a)
-> Functor (YesodClientM site)
forall a b. a -> YesodClientM site b -> YesodClientM site a
forall a b. (a -> b) -> YesodClientM site a -> YesodClientM site b
forall site a b. a -> YesodClientM site b -> YesodClientM site a
forall site a b.
(a -> b) -> YesodClientM site a -> YesodClientM site b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> YesodClientM site b -> YesodClientM site a
$c<$ :: forall site a b. a -> YesodClientM site b -> YesodClientM site a
fmap :: (a -> b) -> YesodClientM site a -> YesodClientM site b
$cfmap :: forall site a b.
(a -> b) -> YesodClientM site a -> YesodClientM site b
Functor,
Functor (YesodClientM site)
a -> YesodClientM site a
Functor (YesodClientM site)
-> (forall a. a -> YesodClientM site a)
-> (forall a b.
YesodClientM site (a -> b)
-> YesodClientM site a -> YesodClientM site b)
-> (forall a b c.
(a -> b -> c)
-> YesodClientM site a
-> YesodClientM site b
-> YesodClientM site c)
-> (forall a b.
YesodClientM site a -> YesodClientM site b -> YesodClientM site b)
-> (forall a b.
YesodClientM site a -> YesodClientM site b -> YesodClientM site a)
-> Applicative (YesodClientM site)
YesodClientM site a -> YesodClientM site b -> YesodClientM site b
YesodClientM site a -> YesodClientM site b -> YesodClientM site a
YesodClientM site (a -> b)
-> YesodClientM site a -> YesodClientM site b
(a -> b -> c)
-> YesodClientM site a
-> YesodClientM site b
-> YesodClientM site c
forall site. Functor (YesodClientM site)
forall a. a -> YesodClientM site a
forall site a. a -> YesodClientM site a
forall a b.
YesodClientM site a -> YesodClientM site b -> YesodClientM site a
forall a b.
YesodClientM site a -> YesodClientM site b -> YesodClientM site b
forall a b.
YesodClientM site (a -> b)
-> YesodClientM site a -> YesodClientM site b
forall site a b.
YesodClientM site a -> YesodClientM site b -> YesodClientM site a
forall site a b.
YesodClientM site a -> YesodClientM site b -> YesodClientM site b
forall site a b.
YesodClientM site (a -> b)
-> YesodClientM site a -> YesodClientM site b
forall a b c.
(a -> b -> c)
-> YesodClientM site a
-> YesodClientM site b
-> YesodClientM site c
forall site a b c.
(a -> b -> c)
-> YesodClientM site a
-> YesodClientM site b
-> YesodClientM site 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
<* :: YesodClientM site a -> YesodClientM site b -> YesodClientM site a
$c<* :: forall site a b.
YesodClientM site a -> YesodClientM site b -> YesodClientM site a
*> :: YesodClientM site a -> YesodClientM site b -> YesodClientM site b
$c*> :: forall site a b.
YesodClientM site a -> YesodClientM site b -> YesodClientM site b
liftA2 :: (a -> b -> c)
-> YesodClientM site a
-> YesodClientM site b
-> YesodClientM site c
$cliftA2 :: forall site a b c.
(a -> b -> c)
-> YesodClientM site a
-> YesodClientM site b
-> YesodClientM site c
<*> :: YesodClientM site (a -> b)
-> YesodClientM site a -> YesodClientM site b
$c<*> :: forall site a b.
YesodClientM site (a -> b)
-> YesodClientM site a -> YesodClientM site b
pure :: a -> YesodClientM site a
$cpure :: forall site a. a -> YesodClientM site a
$cp1Applicative :: forall site. Functor (YesodClientM site)
Applicative,
Applicative (YesodClientM site)
a -> YesodClientM site a
Applicative (YesodClientM site)
-> (forall a b.
YesodClientM site a
-> (a -> YesodClientM site b) -> YesodClientM site b)
-> (forall a b.
YesodClientM site a -> YesodClientM site b -> YesodClientM site b)
-> (forall a. a -> YesodClientM site a)
-> Monad (YesodClientM site)
YesodClientM site a
-> (a -> YesodClientM site b) -> YesodClientM site b
YesodClientM site a -> YesodClientM site b -> YesodClientM site b
forall site. Applicative (YesodClientM site)
forall a. a -> YesodClientM site a
forall site a. a -> YesodClientM site a
forall a b.
YesodClientM site a -> YesodClientM site b -> YesodClientM site b
forall a b.
YesodClientM site a
-> (a -> YesodClientM site b) -> YesodClientM site b
forall site a b.
YesodClientM site a -> YesodClientM site b -> YesodClientM site b
forall site a b.
YesodClientM site a
-> (a -> YesodClientM site b) -> YesodClientM site 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 -> YesodClientM site a
$creturn :: forall site a. a -> YesodClientM site a
>> :: YesodClientM site a -> YesodClientM site b -> YesodClientM site b
$c>> :: forall site a b.
YesodClientM site a -> YesodClientM site b -> YesodClientM site b
>>= :: YesodClientM site a
-> (a -> YesodClientM site b) -> YesodClientM site b
$c>>= :: forall site a b.
YesodClientM site a
-> (a -> YesodClientM site b) -> YesodClientM site b
$cp1Monad :: forall site. Applicative (YesodClientM site)
Monad,
Monad (YesodClientM site)
Monad (YesodClientM site)
-> (forall a. IO a -> YesodClientM site a)
-> MonadIO (YesodClientM site)
IO a -> YesodClientM site a
forall site. Monad (YesodClientM site)
forall a. IO a -> YesodClientM site a
forall site a. IO a -> YesodClientM site a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> YesodClientM site a
$cliftIO :: forall site a. IO a -> YesodClientM site a
$cp1MonadIO :: forall site. Monad (YesodClientM site)
MonadIO,
MonadReader (YesodClient site),
MonadState (YesodClientState site),
Monad (YesodClientM site)
Monad (YesodClientM site)
-> (forall a. String -> YesodClientM site a)
-> MonadFail (YesodClientM site)
String -> YesodClientM site a
forall site. Monad (YesodClientM site)
forall a. String -> YesodClientM site a
forall site a. String -> YesodClientM site a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> YesodClientM site a
$cfail :: forall site a. String -> YesodClientM site a
$cp1MonadFail :: forall site. Monad (YesodClientM site)
MonadFail,
Monad (YesodClientM site)
e -> YesodClientM site a
Monad (YesodClientM site)
-> (forall e a. Exception e => e -> YesodClientM site a)
-> MonadThrow (YesodClientM site)
forall site. Monad (YesodClientM site)
forall e a. Exception e => e -> YesodClientM site a
forall site e a. Exception e => e -> YesodClientM site a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> YesodClientM site a
$cthrowM :: forall site e a. Exception e => e -> YesodClientM site a
$cp1MonadThrow :: forall site. Monad (YesodClientM site)
MonadThrow
)
type YesodExample site a = YesodClientM site a
runYesodClientM :: YesodClient site -> YesodClientM site a -> IO a
runYesodClientM :: YesodClient site -> YesodClientM site a -> IO a
runYesodClientM YesodClient site
cenv (YesodClientM StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
func) = ReaderT (YesodClient site) IO a -> YesodClient site -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
-> YesodClientState site -> ReaderT (YesodClient site) IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
func YesodClientState site
forall site. YesodClientState site
initYesodClientState) YesodClient site
cenv
getRequest :: YesodClientM site (Maybe Request)
getRequest :: YesodClientM site (Maybe Request)
getRequest = (YesodClientState site -> Maybe Request)
-> YesodClientM site (Maybe Request)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (((Request, Response ByteString) -> Request)
-> Maybe (Request, Response ByteString) -> Maybe Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Request, Response ByteString) -> Request
forall a b. (a, b) -> a
fst (Maybe (Request, Response ByteString) -> Maybe Request)
-> (YesodClientState site -> Maybe (Request, Response ByteString))
-> YesodClientState site
-> Maybe Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YesodClientState site -> Maybe (Request, Response ByteString)
forall site.
YesodClientState site -> Maybe (Request, Response ByteString)
yesodClientStateLast)
getResponse :: YesodClientM site (Maybe (Response LB.ByteString))
getResponse :: YesodClientM site (Maybe (Response ByteString))
getResponse = (YesodClientState site -> Maybe (Response ByteString))
-> YesodClientM site (Maybe (Response ByteString))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (((Request, Response ByteString) -> Response ByteString)
-> Maybe (Request, Response ByteString)
-> Maybe (Response ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Request, Response ByteString) -> Response ByteString
forall a b. (a, b) -> b
snd (Maybe (Request, Response ByteString)
-> Maybe (Response ByteString))
-> (YesodClientState site -> Maybe (Request, Response ByteString))
-> YesodClientState site
-> Maybe (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YesodClientState site -> Maybe (Request, Response ByteString)
forall site.
YesodClientState site -> Maybe (Request, Response ByteString)
yesodClientStateLast)
getLast :: YesodClientM site (Maybe (Request, Response LB.ByteString))
getLast :: YesodClientM site (Maybe (Request, Response ByteString))
getLast = (YesodClientState site -> Maybe (Request, Response ByteString))
-> YesodClientM site (Maybe (Request, Response ByteString))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets YesodClientState site -> Maybe (Request, Response ByteString)
forall site.
YesodClientState site -> Maybe (Request, Response ByteString)
yesodClientStateLast
getLocation :: ParseRoute site => YesodClientM site (Either Text (Route site))
getLocation :: YesodClientM site (Either Text (Route site))
getLocation = do
Maybe (Response ByteString)
mr <- YesodClientM site (Maybe (Response ByteString))
forall site. YesodClientM site (Maybe (Response ByteString))
getResponse
case Maybe (Response ByteString)
mr of
Maybe (Response ByteString)
Nothing -> Either Text (Route site)
-> YesodClientM site (Either Text (Route site))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Route site)
-> YesodClientM site (Either Text (Route site)))
-> Either Text (Route site)
-> YesodClientM site (Either Text (Route site))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Route site)
forall a b. a -> Either a b
Left Text
"getLocation called, but there was no previous response, so no Location header"
Just Response ByteString
r -> case HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Location" (Response ByteString -> [(HeaderName, ByteString)]
forall body. Response body -> [(HeaderName, ByteString)]
responseHeaders Response ByteString
r) of
Maybe ByteString
Nothing -> Either Text (Route site)
-> YesodClientM site (Either Text (Route site))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Route site)
-> YesodClientM site (Either Text (Route site)))
-> Either Text (Route site)
-> YesodClientM site (Either Text (Route site))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Route site)
forall a b. a -> Either a b
Left Text
"getLocation called, but the previous response has no Location header"
Just ByteString
h -> case ([Text], [(Text, Text)]) -> Maybe (Route site)
forall a.
ParseRoute a =>
([Text], [(Text, Text)]) -> Maybe (Route a)
parseRoute (([Text], [(Text, Text)]) -> Maybe (Route site))
-> ([Text], [(Text, Text)]) -> Maybe (Route site)
forall a b. (a -> b) -> a -> b
$ ByteString -> ([Text], [(Text, Text)])
decodePath' ByteString
h of
Maybe (Route site)
Nothing -> Either Text (Route site)
-> YesodClientM site (Either Text (Route site))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Route site)
-> YesodClientM site (Either Text (Route site)))
-> Either Text (Route site)
-> YesodClientM site (Either Text (Route site))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Route site)
forall a b. a -> Either a b
Left (Text -> Either Text (Route site))
-> Text -> Either Text (Route site)
forall a b. (a -> b) -> a -> b
$ Text
"getLocation called, but couldn’t parse it into a route: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ByteString -> String
forall a. Show a => a -> String
show ByteString
h)
Just Route site
l -> Either Text (Route site)
-> YesodClientM site (Either Text (Route site))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Route site)
-> YesodClientM site (Either Text (Route site)))
-> Either Text (Route site)
-> YesodClientM site (Either Text (Route site))
forall a b. (a -> b) -> a -> b
$ Route site -> Either Text (Route site)
forall a b. b -> Either a b
Right Route site
l
where
decodePath' :: ByteString -> ([Text], [(Text, Text)])
decodePath' :: ByteString -> ([Text], [(Text, Text)])
decodePath' ByteString
b =
let ([Text]
ss, Query
q) = ByteString -> ([Text], Query)
decodePath (ByteString -> ([Text], Query)) -> ByteString -> ([Text], Query)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
extractPath ByteString
b
in ([Text]
ss, ((Text, Maybe Text) -> (Text, Text))
-> [(Text, Maybe Text)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Maybe Text) -> (Text, Text)
forall b a. Monoid b => (a, Maybe b) -> (a, b)
unJust ([(Text, Maybe Text)] -> [(Text, Text)])
-> [(Text, Maybe Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ Query -> [(Text, Maybe Text)]
queryToQueryText Query
q)
unJust :: (a, Maybe b) -> (a, b)
unJust (a
a, Just b
b) = (a
a, b
b)
unJust (a
a, Maybe b
Nothing) = (a
a, b
forall a. Monoid a => a
mempty)
withLastRequestContext :: YesodClientM site a -> YesodClientM site a
withLastRequestContext :: YesodClientM site a -> YesodClientM site a
withLastRequestContext yfunc :: YesodClientM site a
yfunc@(YesodClientM StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
func) = do
Maybe (Request, Response ByteString)
mLast <- YesodClientM site (Maybe (Request, Response ByteString))
forall site.
YesodClientM site (Maybe (Request, Response ByteString))
getLast
case Maybe (Request, Response ByteString)
mLast of
Maybe (Request, Response ByteString)
Nothing -> YesodClientM site a
yfunc
Just (Request
req, Response ByteString
resp) ->
StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
-> YesodClientM site a
forall site a.
StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
-> YesodClientM site a
YesodClientM (StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
-> YesodClientM site a)
-> StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
-> YesodClientM site a
forall a b. (a -> b) -> a -> b
$ do
YesodClientState site
s <- StateT
(YesodClientState site)
(ReaderT (YesodClient site) IO)
(YesodClientState site)
forall s (m :: * -> *). MonadState s m => m s
get
YesodClient site
c <- StateT
(YesodClientState site)
(ReaderT (YesodClient site) IO)
(YesodClient site)
forall r (m :: * -> *). MonadReader r m => m r
ask
let ctx :: String
ctx =
[String] -> String
unlines
[ String
"last request:",
Request -> String
forall a. Show a => a -> String
ppShow Request
req,
String
"full response:",
Response ByteString -> String
forall a. Show a => a -> String
ppShow Response ByteString
resp
]
(a
r, YesodClientState site
s') <- IO (a, YesodClientState site)
-> StateT
(YesodClientState site)
(ReaderT (YesodClient site) IO)
(a, YesodClientState site)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, YesodClientState site)
-> StateT
(YesodClientState site)
(ReaderT (YesodClient site) IO)
(a, YesodClientState site))
-> IO (a, YesodClientState site)
-> StateT
(YesodClientState site)
(ReaderT (YesodClient site) IO)
(a, YesodClientState site)
forall a b. (a -> b) -> a -> b
$ String
-> IO (a, YesodClientState site) -> IO (a, YesodClientState site)
forall a. String -> IO a -> IO a
context String
ctx (IO (a, YesodClientState site) -> IO (a, YesodClientState site))
-> IO (a, YesodClientState site) -> IO (a, YesodClientState site)
forall a b. (a -> b) -> a -> b
$ ReaderT (YesodClient site) IO (a, YesodClientState site)
-> YesodClient site -> IO (a, YesodClientState site)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
-> YesodClientState site
-> ReaderT (YesodClient site) IO (a, YesodClientState site)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
func YesodClientState site
s) YesodClient site
c
YesodClientState site
-> StateT
(YesodClientState site) (ReaderT (YesodClient site) IO) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put YesodClientState site
s'
a
-> StateT (YesodClientState site) (ReaderT (YesodClient site) IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r