{-# 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 =
        LiteHandler TypedContent
-> YesodRunnerEnv LiteApp -> Maybe (Route LiteApp) -> Application
forall res site.
(ToTypedContent res, Yesod site) =>
HandlerFor site res
-> YesodRunnerEnv site -> Maybe (Route site) -> Application
yesodRunner
            (LiteHandler TypedContent
-> Maybe (LiteHandler TypedContent) -> LiteHandler TypedContent
forall a. a -> Maybe a -> a
fromMaybe LiteHandler TypedContent
forall (m :: * -> *) a. MonadHandler m => m a
notFound (Maybe (LiteHandler TypedContent) -> LiteHandler TypedContent)
-> Maybe (LiteHandler TypedContent) -> LiteHandler TypedContent
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
            (Route LiteApp -> Maybe (Route LiteApp)
forall a. a -> Maybe a
Just (Route LiteApp -> Maybe (Route LiteApp))
-> Route LiteApp -> Maybe (Route LiteApp)
forall a b. (a -> b) -> a -> b
$ [Text] -> Route LiteApp
LiteAppRoute ([Text] -> Route LiteApp) -> [Text] -> Route LiteApp
forall a b. (a -> b) -> a -> b
$ Request -> [Text]
pathInfo Request
req)
            Request
req
      where
        LiteApp Method -> [Text] -> Maybe (LiteHandler TypedContent)
f = YesodRunnerEnv LiteApp -> LiteApp
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
(Int -> Route LiteApp -> ShowS)
-> (Route LiteApp -> String)
-> ([Route LiteApp] -> ShowS)
-> Show (Route LiteApp)
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
(Route LiteApp -> Route LiteApp -> Bool)
-> (Route LiteApp -> Route LiteApp -> Bool) -> Eq (Route LiteApp)
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]
(Int -> ReadS (Route LiteApp))
-> ReadS [Route LiteApp]
-> ReadPrec (Route LiteApp)
-> ReadPrec [Route LiteApp]
-> Read (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)
Eq (Route LiteApp)
-> (Route LiteApp -> Route LiteApp -> Ordering)
-> (Route LiteApp -> Route LiteApp -> Bool)
-> (Route LiteApp -> Route LiteApp -> Bool)
-> (Route LiteApp -> Route LiteApp -> Bool)
-> (Route LiteApp -> Route LiteApp -> Bool)
-> (Route LiteApp -> Route LiteApp -> Route LiteApp)
-> (Route LiteApp -> Route LiteApp -> Route LiteApp)
-> Ord (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
$cp1Ord :: Eq (Route LiteApp)
Ord)
    renderRoute :: Route LiteApp -> ([Text], [(Text, Text)])
renderRoute (LiteAppRoute x) = ([Text]
x, [])
instance ParseRoute LiteApp where
    parseRoute :: ([Text], [(Text, Text)]) -> Maybe (Route LiteApp)
parseRoute ([Text]
x, [(Text, Text)]
_) = Route LiteApp -> Maybe (Route LiteApp)
forall a. a -> Maybe a
Just (Route LiteApp -> Maybe (Route LiteApp))
-> Route LiteApp -> Maybe (Route LiteApp)
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 ((Method -> [Text] -> Maybe (LiteHandler TypedContent)) -> LiteApp)
-> (Method -> [Text] -> Maybe (LiteHandler TypedContent))
-> LiteApp
forall a b. (a -> b) -> a -> b
$ \Method
m [Text]
ps -> Method -> [Text] -> Maybe (LiteHandler TypedContent)
x Method
m [Text]
ps Maybe (LiteHandler TypedContent)
-> Maybe (LiteHandler TypedContent)
-> Maybe (LiteHandler TypedContent)
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 ((Method -> [Text] -> Maybe (LiteHandler TypedContent)) -> LiteApp)
-> (Method -> [Text] -> Maybe (LiteHandler TypedContent))
-> LiteApp
forall a b. (a -> b) -> a -> b
$ \Method
_ [Text]
_ -> Maybe (LiteHandler TypedContent)
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 = Writer LiteApp () -> LiteApp
forall w a. Writer w a -> w
execWriter

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

onMethod :: Method -> Writer LiteApp () -> Writer LiteApp ()
onMethod :: Method -> Writer LiteApp () -> Writer LiteApp ()
onMethod Method
method Writer LiteApp ()
f = LiteApp -> Writer LiteApp ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (LiteApp -> Writer LiteApp ()) -> LiteApp -> Writer LiteApp ()
forall a b. (a -> b) -> a -> b
$ (Method -> [Text] -> Maybe (LiteHandler TypedContent)) -> LiteApp
LiteApp ((Method -> [Text] -> Maybe (LiteHandler TypedContent)) -> LiteApp)
-> (Method -> [Text] -> Maybe (LiteHandler TypedContent))
-> LiteApp
forall a b. (a -> b) -> a -> b
$ \Method
m [Text]
ps ->
    if Method
method Method -> Method -> Bool
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 Maybe (LiteHandler TypedContent)
forall a. Maybe a
Nothing

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

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

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