module Web.Routes.Nested.Types
(
Tries (..)
,
RouterT (..)
, execRouterT
, ActionT
, action
,
ExtrudeSoundly
) where
import Web.Routes.Nested.Match
import Network.Wai.Middleware.Verbs
import Network.Wai.Middleware.ContentType
import Network.Wai.Trans
import Data.Trie.Pred.Base (RootedPredTrie (..))
import Data.Trie.Pred.Interface.Types (Extrude (..), CatMaybes)
import Data.Monoid
import qualified Data.Text as T
import Data.Function.Poly
import Control.Monad.Trans
import qualified Control.Monad.State as S
data Tries x s = Tries
{ trieContent :: !(RootedPredTrie T.Text x)
, trieCatchAll :: !(RootedPredTrie T.Text x)
, trieSecurity :: !(RootedPredTrie T.Text s)
}
instance Monoid (Tries x s) where
mempty = Tries mempty mempty mempty
mappend (Tries x1 x2 x3) (Tries y1 y2 y3) =
((Tries $! x1 <> y1)
$! x2 <> y2)
$! x3 <> y3
newtype RouterT x sec m a = RouterT
{ runRouterT :: S.StateT (Tries x sec) m a
} deriving ( Functor, Applicative, Monad, MonadIO, MonadTrans
, S.MonadState (Tries x sec))
execRouterT :: Monad m => RouterT x sec m a -> m (Tries x sec)
execRouterT hs = S.execStateT (runRouterT hs) mempty
type ExtrudeSoundly xs' xs c r =
( xs' ~ CatMaybes xs
, ArityTypeListIso c xs' r
, Extrude (UrlChunks xs)
(RootedPredTrie T.Text c)
(RootedPredTrie T.Text r)
)
type ActionT m a = VerbListenerT (FileExtListenerT m a) m a
action :: Monad m => ActionT m () -> MiddlewareT m
action xs app req respond = do
vmap <- fmap fileExtsToMiddleware <$> execVerbListenerT xs
case lookupVerb (getVerb req) vmap of
Nothing -> app req respond
Just mid -> mid app req respond