{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Webby.Types where
import qualified Control.Monad.IO.Unlift as Un
import qualified Data.Binary.Builder as Bu
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import qualified UnliftIO as U
import qualified UnliftIO.Concurrent as Conc
import Prelude
data WyResp = WyResp
{ WyResp -> Status
wrStatus :: Status,
:: ResponseHeaders,
WyResp -> Either StreamingBody Builder
wrRespData :: Either StreamingBody Bu.Builder,
WyResp -> Bool
wrResponded :: Bool
}
defaultWyResp :: WyResp
defaultWyResp :: WyResp
defaultWyResp = Status
-> ResponseHeaders
-> Either StreamingBody Builder
-> Bool
-> WyResp
WyResp Status
status200 [] (forall a b. b -> Either a b
Right Builder
Bu.empty) Bool
False
data WebbyExceptionHandler env = forall e. Exception e => WebbyExceptionHandler (e -> (WebbyM env) ())
data WEnv env = WEnv
{ forall env. WEnv env -> MVar WyResp
weResp :: Conc.MVar WyResp,
forall env. WEnv env -> Captures
weCaptures :: Captures,
forall env. WEnv env -> Request
weRequest :: Request,
forall env. WEnv env -> env
weAppEnv :: env,
forall env. WEnv env -> Maybe (WebbyExceptionHandler env)
weExceptionHandler :: Maybe (WebbyExceptionHandler env)
}
newtype WebbyM appEnv a = WebbyM
{ forall appEnv a.
WebbyM appEnv a
-> ReaderT appEnv (ReaderT (WEnv appEnv) (ResourceT IO)) a
unWebbyM :: ReaderT appEnv (ReaderT (WEnv appEnv) (ResourceT IO)) a
}
deriving newtype (forall a b. a -> WebbyM appEnv b -> WebbyM appEnv a
forall a b. (a -> b) -> WebbyM appEnv a -> WebbyM appEnv b
forall appEnv a b. a -> WebbyM appEnv b -> WebbyM appEnv a
forall appEnv a b. (a -> b) -> WebbyM appEnv a -> WebbyM appEnv 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 -> WebbyM appEnv b -> WebbyM appEnv a
$c<$ :: forall appEnv a b. a -> WebbyM appEnv b -> WebbyM appEnv a
fmap :: forall a b. (a -> b) -> WebbyM appEnv a -> WebbyM appEnv b
$cfmap :: forall appEnv a b. (a -> b) -> WebbyM appEnv a -> WebbyM appEnv b
Functor, forall appEnv. Functor (WebbyM appEnv)
forall a. a -> WebbyM appEnv a
forall appEnv a. a -> WebbyM appEnv a
forall a b. WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv a
forall a b. WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv b
forall a b.
WebbyM appEnv (a -> b) -> WebbyM appEnv a -> WebbyM appEnv b
forall appEnv a b.
WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv a
forall appEnv a b.
WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv b
forall appEnv a b.
WebbyM appEnv (a -> b) -> WebbyM appEnv a -> WebbyM appEnv b
forall a b c.
(a -> b -> c)
-> WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv c
forall appEnv a b c.
(a -> b -> c)
-> WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv 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. WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv a
$c<* :: forall appEnv a b.
WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv a
*> :: forall a b. WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv b
$c*> :: forall appEnv a b.
WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv b
liftA2 :: forall a b c.
(a -> b -> c)
-> WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv c
$cliftA2 :: forall appEnv a b c.
(a -> b -> c)
-> WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv c
<*> :: forall a b.
WebbyM appEnv (a -> b) -> WebbyM appEnv a -> WebbyM appEnv b
$c<*> :: forall appEnv a b.
WebbyM appEnv (a -> b) -> WebbyM appEnv a -> WebbyM appEnv b
pure :: forall a. a -> WebbyM appEnv a
$cpure :: forall appEnv a. a -> WebbyM appEnv a
Applicative, forall appEnv. Applicative (WebbyM appEnv)
forall a. a -> WebbyM appEnv a
forall appEnv a. a -> WebbyM appEnv a
forall a b. WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv b
forall a b.
WebbyM appEnv a -> (a -> WebbyM appEnv b) -> WebbyM appEnv b
forall appEnv a b.
WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv b
forall appEnv a b.
WebbyM appEnv a -> (a -> WebbyM appEnv b) -> WebbyM appEnv 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 -> WebbyM appEnv a
$creturn :: forall appEnv a. a -> WebbyM appEnv a
>> :: forall a b. WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv b
$c>> :: forall appEnv a b.
WebbyM appEnv a -> WebbyM appEnv b -> WebbyM appEnv b
>>= :: forall a b.
WebbyM appEnv a -> (a -> WebbyM appEnv b) -> WebbyM appEnv b
$c>>= :: forall appEnv a b.
WebbyM appEnv a -> (a -> WebbyM appEnv b) -> WebbyM appEnv b
Monad, forall appEnv. Monad (WebbyM appEnv)
forall a. IO a -> WebbyM appEnv a
forall appEnv a. IO a -> WebbyM appEnv a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> WebbyM appEnv a
$cliftIO :: forall appEnv a. IO a -> WebbyM appEnv a
MonadIO, MonadReader appEnv, forall appEnv. MonadIO (WebbyM appEnv)
forall b.
((forall a. WebbyM appEnv a -> IO a) -> IO b) -> WebbyM appEnv b
forall appEnv b.
((forall a. WebbyM appEnv a -> IO a) -> IO b) -> WebbyM appEnv b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: forall b.
((forall a. WebbyM appEnv a -> IO a) -> IO b) -> WebbyM appEnv b
$cwithRunInIO :: forall appEnv b.
((forall a. WebbyM appEnv a -> IO a) -> IO b) -> WebbyM appEnv b
Un.MonadUnliftIO)
runWebbyM :: WEnv w -> WebbyM w a -> IO a
runWebbyM :: forall w a. WEnv w -> WebbyM w a -> IO a
runWebbyM WEnv w
env = forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT WEnv w
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT w
appEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall appEnv a.
WebbyM appEnv a
-> ReaderT appEnv (ReaderT (WEnv appEnv) (ResourceT IO)) a
unWebbyM
where
appEnv :: w
appEnv = forall env. WEnv env -> env
weAppEnv WEnv w
env
data RoutePattern = RoutePattern Method [Text]
deriving stock (RoutePattern -> RoutePattern -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RoutePattern -> RoutePattern -> Bool
$c/= :: RoutePattern -> RoutePattern -> Bool
== :: RoutePattern -> RoutePattern -> Bool
$c== :: RoutePattern -> RoutePattern -> Bool
Eq, Int -> RoutePattern -> ShowS
[RoutePattern] -> ShowS
RoutePattern -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoutePattern] -> ShowS
$cshowList :: [RoutePattern] -> ShowS
show :: RoutePattern -> String
$cshow :: RoutePattern -> String
showsPrec :: Int -> RoutePattern -> ShowS
$cshowsPrec :: Int -> RoutePattern -> ShowS
Show)
type Route env = (RoutePattern, WebbyM env ())
type Captures = H.HashMap Text Text
data FinishThrown = FinishThrown
deriving stock (Int -> FinishThrown -> ShowS
[FinishThrown] -> ShowS
FinishThrown -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FinishThrown] -> ShowS
$cshowList :: [FinishThrown] -> ShowS
show :: FinishThrown -> String
$cshow :: FinishThrown -> String
showsPrec :: Int -> FinishThrown -> ShowS
$cshowsPrec :: Int -> FinishThrown -> ShowS
Show)
instance U.Exception FinishThrown
data WebbyError
= WebbyJSONParseError Text
| WebbyParamParseError
{ WebbyError -> Text
wppeParamName :: Text,
WebbyError -> Text
wppeErrMsg :: Text
}
| WebbyMissingCapture Text
deriving stock (Int -> WebbyError -> ShowS
[WebbyError] -> ShowS
WebbyError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebbyError] -> ShowS
$cshowList :: [WebbyError] -> ShowS
show :: WebbyError -> String
$cshow :: WebbyError -> String
showsPrec :: Int -> WebbyError -> ShowS
$cshowsPrec :: Int -> WebbyError -> ShowS
Show)
instance U.Exception WebbyError where
displayException :: WebbyError -> String
displayException (WebbyParamParseError Text
pName Text
msg) =
Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Format Text a -> a
sformat (Format (Text -> Text -> Text) (Text -> Text -> Text)
"Param parse error: " forall r a r'. Format r a -> Format r' r -> Format r' a
% forall r. Format r (Text -> r)
st forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Text -> Text) (Text -> Text)
" " forall r a r'. Format r a -> Format r' r -> Format r' a
% forall r. Format r (Text -> r)
st) Text
pName Text
msg
displayException (WebbyJSONParseError Text
_) = String
"Invalid JSON body"
displayException (WebbyMissingCapture Text
capName) =
Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Format Text a -> a
sformat (forall r. Format r (Text -> r)
st forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text Text
" missing") Text
capName
data WebbyServerConfig env = WebbyServerConfig
{ forall env. WebbyServerConfig env -> [Route env]
wscRoutes :: [Route env],
forall env.
WebbyServerConfig env -> Maybe (WebbyExceptionHandler env)
wscExceptionHandler :: Maybe (WebbyExceptionHandler env)
}
defaultWebbyServerConfig :: WebbyServerConfig env
defaultWebbyServerConfig :: forall env. WebbyServerConfig env
defaultWebbyServerConfig =
WebbyServerConfig
{ wscRoutes :: [Route env]
wscRoutes = [],
wscExceptionHandler :: Maybe (WebbyExceptionHandler env)
wscExceptionHandler = forall a. Maybe a
Nothing :: Maybe (WebbyExceptionHandler env)
}
setRoutes ::
[Route env] ->
WebbyServerConfig env ->
WebbyServerConfig env
setRoutes :: forall env.
[Route env] -> WebbyServerConfig env -> WebbyServerConfig env
setRoutes [Route env]
routes WebbyServerConfig env
wsc =
WebbyServerConfig env
wsc
{ wscRoutes :: [Route env]
wscRoutes = [Route env]
routes
}
setExceptionHandler ::
Exception e =>
(e -> WebbyM env ()) ->
WebbyServerConfig env ->
WebbyServerConfig env
setExceptionHandler :: forall e env.
Exception e =>
(e -> WebbyM env ())
-> WebbyServerConfig env -> WebbyServerConfig env
setExceptionHandler e -> WebbyM env ()
exceptionHandler WebbyServerConfig env
wsc =
WebbyServerConfig
{ wscRoutes :: [Route env]
wscRoutes = forall env. WebbyServerConfig env -> [Route env]
wscRoutes WebbyServerConfig env
wsc,
wscExceptionHandler :: Maybe (WebbyExceptionHandler env)
wscExceptionHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall env e.
Exception e =>
(e -> WebbyM env ()) -> WebbyExceptionHandler env
WebbyExceptionHandler e -> WebbyM env ()
exceptionHandler
}