{-# LANGUAGE TypeFamilies, PatternGuards, CPP #-}
module Yesod.Core.Internal.LiteApp where

#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import Yesod.Routes.Class
import Yesod.Core.Class.Yesod
import Yesod.Core.Class.Dispatch
import Yesod.Core.Types
import Yesod.Core.Content
import Data.Text (Text)
import Web.PathPieces
import Network.Wai
import Yesod.Core.Handler
import Yesod.Core.Internal.Run
import Network.HTTP.Types (Method)
import Data.Maybe (fromMaybe)
import Control.Applicative ((<|>))
import Control.Monad.Trans.Writer

newtype LiteApp = LiteApp
    { LiteApp -> Method -> [Text] -> Maybe (LiteHandler TypedContent)
unLiteApp :: Method -> [Text] -> Maybe (LiteHandler TypedContent)
    }

instance Yesod LiteApp

instance YesodDispatch LiteApp where
    yesodDispatch :: YesodRunnerEnv LiteApp -> Application
yesodDispatch YesodRunnerEnv LiteApp
yre Request
req =
        forall res site.
(ToTypedContent res, Yesod site) =>
HandlerFor site res
-> YesodRunnerEnv site -> Maybe (Route site) -> Application
yesodRunner
            (forall a. a -> Maybe a -> a
fromMaybe forall (m :: * -> *) a. MonadHandler m => m a
notFound forall a b. (a -> b) -> a -> b
$ Method -> [Text] -> Maybe (LiteHandler TypedContent)
f (Request -> Method
requestMethod Request
req) (Request -> [Text]
pathInfo Request
req))
            YesodRunnerEnv LiteApp
yre
            (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Text] -> Route LiteApp
LiteAppRoute forall a b. (a -> b) -> a -> b
$ Request -> [Text]
pathInfo Request
req)
            Request
req
      where
        LiteApp Method -> [Text] -> Maybe (LiteHandler TypedContent)
f = forall site. YesodRunnerEnv site -> site
yreSite YesodRunnerEnv LiteApp
yre

instance RenderRoute LiteApp where
    data Route LiteApp = LiteAppRoute [Text]
        deriving (Int -> Route LiteApp -> ShowS
[Route LiteApp] -> ShowS
Route LiteApp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Route LiteApp] -> ShowS
$cshowList :: [Route LiteApp] -> ShowS
show :: Route LiteApp -> String
$cshow :: Route LiteApp -> String
showsPrec :: Int -> Route LiteApp -> ShowS
$cshowsPrec :: Int -> Route LiteApp -> ShowS
Show, Route LiteApp -> Route LiteApp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Route LiteApp -> Route LiteApp -> Bool
$c/= :: Route LiteApp -> Route LiteApp -> Bool
== :: Route LiteApp -> Route LiteApp -> Bool
$c== :: Route LiteApp -> Route LiteApp -> Bool
Eq, ReadPrec [Route LiteApp]
ReadPrec (Route LiteApp)
Int -> ReadS (Route LiteApp)
ReadS [Route LiteApp]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Route LiteApp]
$creadListPrec :: ReadPrec [Route LiteApp]
readPrec :: ReadPrec (Route LiteApp)
$creadPrec :: ReadPrec (Route LiteApp)
readList :: ReadS [Route LiteApp]
$creadList :: ReadS [Route LiteApp]
readsPrec :: Int -> ReadS (Route LiteApp)
$creadsPrec :: Int -> ReadS (Route LiteApp)
Read, Eq (Route LiteApp)
Route LiteApp -> Route LiteApp -> Bool
Route LiteApp -> Route LiteApp -> Ordering
Route LiteApp -> Route LiteApp -> Route LiteApp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Route LiteApp -> Route LiteApp -> Route LiteApp
$cmin :: Route LiteApp -> Route LiteApp -> Route LiteApp
max :: Route LiteApp -> Route LiteApp -> Route LiteApp
$cmax :: Route LiteApp -> Route LiteApp -> Route LiteApp
>= :: Route LiteApp -> Route LiteApp -> Bool
$c>= :: Route LiteApp -> Route LiteApp -> Bool
> :: Route LiteApp -> Route LiteApp -> Bool
$c> :: Route LiteApp -> Route LiteApp -> Bool
<= :: Route LiteApp -> Route LiteApp -> Bool
$c<= :: Route LiteApp -> Route LiteApp -> Bool
< :: Route LiteApp -> Route LiteApp -> Bool
$c< :: Route LiteApp -> Route LiteApp -> Bool
compare :: Route LiteApp -> Route LiteApp -> Ordering
$ccompare :: Route LiteApp -> Route LiteApp -> Ordering
Ord)
    renderRoute :: Route LiteApp -> ([Text], [(Text, Text)])
renderRoute (LiteAppRoute [Text]
x) = ([Text]
x, [])
instance ParseRoute LiteApp where
    parseRoute :: ([Text], [(Text, Text)]) -> Maybe (Route LiteApp)
parseRoute ([Text]
x, [(Text, Text)]
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Text] -> Route LiteApp
LiteAppRoute [Text]
x

instance Semigroup LiteApp where
    LiteApp Method -> [Text] -> Maybe (LiteHandler TypedContent)
x <> :: LiteApp -> LiteApp -> LiteApp
<> LiteApp Method -> [Text] -> Maybe (LiteHandler TypedContent)
y = (Method -> [Text] -> Maybe (LiteHandler TypedContent)) -> LiteApp
LiteApp forall a b. (a -> b) -> a -> b
$ \Method
m [Text]
ps -> Method -> [Text] -> Maybe (LiteHandler TypedContent)
x Method
m [Text]
ps forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Method -> [Text] -> Maybe (LiteHandler TypedContent)
y Method
m [Text]
ps

instance Monoid LiteApp where
    mempty :: LiteApp
mempty = (Method -> [Text] -> Maybe (LiteHandler TypedContent)) -> LiteApp
LiteApp forall a b. (a -> b) -> a -> b
$ \Method
_ [Text]
_ -> forall a. Maybe a
Nothing
#if !(MIN_VERSION_base(4,11,0))
    mappend = (<>)
#endif

type LiteHandler = HandlerFor LiteApp
type LiteWidget = WidgetFor LiteApp

liteApp :: Writer LiteApp () -> LiteApp
liteApp :: Writer LiteApp () -> LiteApp
liteApp = forall w a. Writer w a -> w
execWriter

dispatchTo :: ToTypedContent a => LiteHandler a -> Writer LiteApp ()
dispatchTo :: forall a. ToTypedContent a => LiteHandler a -> Writer LiteApp ()
dispatchTo LiteHandler a
handler = forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell forall a b. (a -> b) -> a -> b
$ (Method -> [Text] -> Maybe (LiteHandler TypedContent)) -> LiteApp
LiteApp forall a b. (a -> b) -> a -> b
$ \Method
_ [Text]
ps ->
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ps
        then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToTypedContent a => a -> TypedContent
toTypedContent LiteHandler a
handler
        else forall a. Maybe a
Nothing

onMethod :: Method -> Writer LiteApp () -> Writer LiteApp ()
onMethod :: Method -> Writer LiteApp () -> Writer LiteApp ()
onMethod Method
method Writer LiteApp ()
f = forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell forall a b. (a -> b) -> a -> b
$ (Method -> [Text] -> Maybe (LiteHandler TypedContent)) -> LiteApp
LiteApp forall a b. (a -> b) -> a -> b
$ \Method
m [Text]
ps ->
    if Method
method forall a. Eq a => a -> a -> Bool
== Method
m
        then LiteApp -> Method -> [Text] -> Maybe (LiteHandler TypedContent)
unLiteApp (Writer LiteApp () -> LiteApp
liteApp Writer LiteApp ()
f) Method
m [Text]
ps
        else forall a. Maybe a
Nothing

onStatic :: Text -> Writer LiteApp () -> Writer LiteApp ()
onStatic :: Text -> Writer LiteApp () -> Writer LiteApp ()
onStatic Text
p0 Writer LiteApp ()
f = forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell forall a b. (a -> b) -> a -> b
$ (Method -> [Text] -> Maybe (LiteHandler TypedContent)) -> LiteApp
LiteApp forall a b. (a -> b) -> a -> b
$ \Method
m [Text]
ps0 ->
    case [Text]
ps0 of
        Text
p:[Text]
ps | Text
p forall a. Eq a => a -> a -> Bool
== Text
p0 -> LiteApp -> Method -> [Text] -> Maybe (LiteHandler TypedContent)
unLiteApp (Writer LiteApp () -> LiteApp
liteApp Writer LiteApp ()
f) Method
m [Text]
ps
        [Text]
_ -> forall a. Maybe a
Nothing

withDynamic :: PathPiece p => (p -> Writer LiteApp ()) -> Writer LiteApp ()
withDynamic :: forall p.
PathPiece p =>
(p -> Writer LiteApp ()) -> Writer LiteApp ()
withDynamic p -> Writer LiteApp ()
f = forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell forall a b. (a -> b) -> a -> b
$ (Method -> [Text] -> Maybe (LiteHandler TypedContent)) -> LiteApp
LiteApp forall a b. (a -> b) -> a -> b
$ \Method
m [Text]
ps0 ->
    case [Text]
ps0 of
        Text
p:[Text]
ps | Just p
v <- forall s. PathPiece s => Text -> Maybe s
fromPathPiece Text
p -> LiteApp -> Method -> [Text] -> Maybe (LiteHandler TypedContent)
unLiteApp (Writer LiteApp () -> LiteApp
liteApp forall a b. (a -> b) -> a -> b
$ p -> Writer LiteApp ()
f p
v) Method
m [Text]
ps
        [Text]
_ -> forall a. Maybe a
Nothing

withDynamicMulti :: PathMultiPiece ps => (ps -> Writer LiteApp ()) -> Writer LiteApp ()
withDynamicMulti :: forall ps.
PathMultiPiece ps =>
(ps -> Writer LiteApp ()) -> Writer LiteApp ()
withDynamicMulti ps -> Writer LiteApp ()
f = forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell forall a b. (a -> b) -> a -> b
$ (Method -> [Text] -> Maybe (LiteHandler TypedContent)) -> LiteApp
LiteApp forall a b. (a -> b) -> a -> b
$ \Method
m [Text]
ps ->
    case forall s. PathMultiPiece s => [Text] -> Maybe s
fromPathMultiPiece [Text]
ps of
        Maybe ps
Nothing -> forall a. Maybe a
Nothing
        Just ps
v -> LiteApp -> Method -> [Text] -> Maybe (LiteHandler TypedContent)
unLiteApp (Writer LiteApp () -> LiteApp
liteApp forall a b. (a -> b) -> a -> b
$ ps -> Writer LiteApp ()
f ps
v) Method
m []