{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Web.Route.RouteT
-- Copyright   :  (c) 2010 Jeremy Shaw
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  partners@seereason.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Declaration of the 'RouteT' monad transformer
-----------------------------------------------------------------------------
module Web.Routes.RouteT where

import Control.Applicative (Applicative((<*>), pure), Alternative((<|>), empty))
import Control.Monad (MonadPlus(mzero, mplus))
import Control.Monad.Catch (MonadCatch(catch), MonadThrow(throwM))
import Control.Monad.Cont(MonadCont(callCC))
import Control.Monad.Error (MonadError(throwError, catchError))
#if !MIN_VERSION_base(4,13,0)
-- Control.Monad.Fail import is redundant since GHC 8.8.1
import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail(..))
#endif
import Control.Monad.Fix (MonadFix(mfix))
import Control.Monad.Reader(MonadReader(ask,local))
import Control.Monad.RWS (MonadRWS)
import Control.Monad.State(MonadState(get,put))
import Control.Monad.Trans (MonadTrans(lift), MonadIO(liftIO))
import Control.Monad.Writer(MonadWriter(listen, tell, pass))
import Data.Text (Text)


-- * RouteT Monad Transformer

-- |monad transformer for generating URLs
newtype RouteT url m a = RouteT { RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT :: (url -> [(Text, Maybe Text)] -> Text) -> m a }

class (Monad m) => MonadRoute m where
    type URL m
    askRouteFn :: m (URL m -> [(Text, Maybe Text)] -> Text)

instance MonadCatch m => MonadCatch (RouteT url m) where
    catch :: RouteT url m a -> (e -> RouteT url m a) -> RouteT url m a
catch RouteT url m a
action e -> RouteT url m a
handler =
        ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a)
-> ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall a b. (a -> b) -> a -> b
$ \ url -> [(Text, Maybe Text)] -> Text
fn -> m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch ((url -> [(Text, Maybe Text)] -> Text) -> m a
action' url -> [(Text, Maybe Text)] -> Text
fn) (\ e
e -> e -> (url -> [(Text, Maybe Text)] -> Text) -> m a
handler' e
e url -> [(Text, Maybe Text)] -> Text
fn)
        where
          action' :: (url -> [(Text, Maybe Text)] -> Text) -> m a
action' = RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT RouteT url m a
action
          handler' :: e -> (url -> [(Text, Maybe Text)] -> Text) -> m a
handler' e
e = RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT (e -> RouteT url m a
handler e
e)

instance MonadThrow m => MonadThrow (RouteT url m) where
    throwM :: e -> RouteT url m a
throwM = e -> RouteT url m a
forall (m :: * -> *) e url a.
(MonadThrow m, Exception e) =>
e -> RouteT url m a
throwM'
        where
          throwM' :: e -> RouteT url m a
throwM' e
e = ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a)
-> ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall a b. (a -> b) -> a -> b
$ \ url -> [(Text, Maybe Text)] -> Text
_fn -> e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e

-- | convert a 'RouteT' based route handler to a handler that can be used with the 'Site' type
--
-- NOTE: this function used to be the same as 'unRouteT'. If you want the old behavior, just call 'unRouteT'.
runRouteT :: (url -> RouteT url m a)
          -> ((url -> [(Text, Maybe Text)] -> Text) -> url -> m a)
runRouteT :: (url -> RouteT url m a)
-> (url -> [(Text, Maybe Text)] -> Text) -> url -> m a
runRouteT url -> RouteT url m a
r = \url -> [(Text, Maybe Text)] -> Text
f url
u -> (RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT (url -> RouteT url m a
r url
u)) url -> [(Text, Maybe Text)] -> Text
f

-- | Transform the computation inside a @RouteT@.
mapRouteT :: (m a -> n b) -> RouteT url m a -> RouteT url n b
mapRouteT :: (m a -> n b) -> RouteT url m a -> RouteT url n b
mapRouteT m a -> n b
f (RouteT (url -> [(Text, Maybe Text)] -> Text) -> m a
m) = ((url -> [(Text, Maybe Text)] -> Text) -> n b) -> RouteT url n b
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url -> [(Text, Maybe Text)] -> Text) -> n b) -> RouteT url n b)
-> ((url -> [(Text, Maybe Text)] -> Text) -> n b) -> RouteT url n b
forall a b. (a -> b) -> a -> b
$ m a -> n b
f (m a -> n b)
-> ((url -> [(Text, Maybe Text)] -> Text) -> m a)
-> (url -> [(Text, Maybe Text)] -> Text)
-> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (url -> [(Text, Maybe Text)] -> Text) -> m a
m

-- | Execute a computation in a modified environment
withRouteT :: ((url' -> [(Text, Maybe Text)] -> Text) -> (url -> [(Text, Maybe Text)] -> Text)) -> RouteT url m a -> RouteT url' m a
withRouteT :: ((url' -> [(Text, Maybe Text)] -> Text)
 -> url -> [(Text, Maybe Text)] -> Text)
-> RouteT url m a -> RouteT url' m a
withRouteT (url' -> [(Text, Maybe Text)] -> Text)
-> url -> [(Text, Maybe Text)] -> Text
f (RouteT (url -> [(Text, Maybe Text)] -> Text) -> m a
m) = ((url' -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url' m a
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url' -> [(Text, Maybe Text)] -> Text) -> m a)
 -> RouteT url' m a)
-> ((url' -> [(Text, Maybe Text)] -> Text) -> m a)
-> RouteT url' m a
forall a b. (a -> b) -> a -> b
$ (url -> [(Text, Maybe Text)] -> Text) -> m a
m ((url -> [(Text, Maybe Text)] -> Text) -> m a)
-> ((url' -> [(Text, Maybe Text)] -> Text)
    -> url -> [(Text, Maybe Text)] -> Text)
-> (url' -> [(Text, Maybe Text)] -> Text)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (url' -> [(Text, Maybe Text)] -> Text)
-> url -> [(Text, Maybe Text)] -> Text
f

liftRouteT :: m a -> RouteT url m a
liftRouteT :: m a -> RouteT url m a
liftRouteT m a
m = ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall a b. a -> b -> a
const m a
m)

askRouteT :: (Monad m) => RouteT url m (url -> [(Text, Maybe Text)] -> Text)
askRouteT :: RouteT url m (url -> [(Text, Maybe Text)] -> Text)
askRouteT = ((url -> [(Text, Maybe Text)] -> Text)
 -> m (url -> [(Text, Maybe Text)] -> Text))
-> RouteT url m (url -> [(Text, Maybe Text)] -> Text)
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (url -> [(Text, Maybe Text)] -> Text)
-> m (url -> [(Text, Maybe Text)] -> Text)
forall (m :: * -> *) a. Monad m => a -> m a
return

instance (Functor m) => Functor (RouteT url m) where
  fmap :: (a -> b) -> RouteT url m a -> RouteT url m b
fmap a -> b
f = (m a -> m b) -> RouteT url m a -> RouteT url m b
forall (m :: * -> *) a (n :: * -> *) b url.
(m a -> n b) -> RouteT url m a -> RouteT url n b
mapRouteT ((a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)

instance (Applicative m) => Applicative (RouteT url m) where
  pure :: a -> RouteT url m a
pure = m a -> RouteT url m a
forall (m :: * -> *) a url. m a -> RouteT url m a
liftRouteT (m a -> RouteT url m a) -> (a -> m a) -> a -> RouteT url m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  RouteT url m (a -> b)
f <*> :: RouteT url m (a -> b) -> RouteT url m a -> RouteT url m b
<*> RouteT url m a
v = ((url -> [(Text, Maybe Text)] -> Text) -> m b) -> RouteT url m b
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url -> [(Text, Maybe Text)] -> Text) -> m b) -> RouteT url m b)
-> ((url -> [(Text, Maybe Text)] -> Text) -> m b) -> RouteT url m b
forall a b. (a -> b) -> a -> b
$ \ url -> [(Text, Maybe Text)] -> Text
url -> RouteT url m (a -> b)
-> (url -> [(Text, Maybe Text)] -> Text) -> m (a -> b)
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT RouteT url m (a -> b)
f url -> [(Text, Maybe Text)] -> Text
url m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT RouteT url m a
v url -> [(Text, Maybe Text)] -> Text
url

instance (Alternative m) => Alternative (RouteT url m) where
    empty :: RouteT url m a
empty   = m a -> RouteT url m a
forall (m :: * -> *) a url. m a -> RouteT url m a
liftRouteT m a
forall (f :: * -> *) a. Alternative f => f a
empty
    RouteT url m a
m <|> :: RouteT url m a -> RouteT url m a -> RouteT url m a
<|> RouteT url m a
n = ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a)
-> ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall a b. (a -> b) -> a -> b
$ \ url -> [(Text, Maybe Text)] -> Text
url -> RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT RouteT url m a
m url -> [(Text, Maybe Text)] -> Text
url m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT RouteT url m a
n url -> [(Text, Maybe Text)] -> Text
url

instance (Monad m) => Monad (RouteT url m) where
    return :: a -> RouteT url m a
return   = m a -> RouteT url m a
forall (m :: * -> *) a url. m a -> RouteT url m a
liftRouteT (m a -> RouteT url m a) -> (a -> m a) -> a -> RouteT url m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    RouteT url m a
m >>= :: RouteT url m a -> (a -> RouteT url m b) -> RouteT url m b
>>= a -> RouteT url m b
k  = ((url -> [(Text, Maybe Text)] -> Text) -> m b) -> RouteT url m b
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url -> [(Text, Maybe Text)] -> Text) -> m b) -> RouteT url m b)
-> ((url -> [(Text, Maybe Text)] -> Text) -> m b) -> RouteT url m b
forall a b. (a -> b) -> a -> b
$ \ url -> [(Text, Maybe Text)] -> Text
url -> do
        a
a <- RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT RouteT url m a
m url -> [(Text, Maybe Text)] -> Text
url
        RouteT url m b -> (url -> [(Text, Maybe Text)] -> Text) -> m b
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT (a -> RouteT url m b
k a
a) url -> [(Text, Maybe Text)] -> Text
url

instance (MonadFail m) => MonadFail (RouteT url m) where
    fail :: String -> RouteT url m a
fail String
msg = m a -> RouteT url m a
forall (m :: * -> *) a url. m a -> RouteT url m a
liftRouteT (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg)

instance (MonadPlus m, Monad (RouteT url m)) => MonadPlus (RouteT url m) where
    mzero :: RouteT url m a
mzero       = m a -> RouteT url m a
forall (m :: * -> *) a url. m a -> RouteT url m a
liftRouteT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    RouteT url m a
m mplus :: RouteT url m a -> RouteT url m a -> RouteT url m a
`mplus` RouteT url m a
n = ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a)
-> ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall a b. (a -> b) -> a -> b
$ \ url -> [(Text, Maybe Text)] -> Text
url -> RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT RouteT url m a
m url -> [(Text, Maybe Text)] -> Text
url m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT RouteT url m a
n url -> [(Text, Maybe Text)] -> Text
url

instance (MonadCont m) => MonadCont (RouteT url m) where
    callCC :: ((a -> RouteT url m b) -> RouteT url m a) -> RouteT url m a
callCC (a -> RouteT url m b) -> RouteT url m a
f = ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a)
-> ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall a b. (a -> b) -> a -> b
$ \url -> [(Text, Maybe Text)] -> Text
url ->
        ((a -> m b) -> m a) -> m a
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((a -> m b) -> m a) -> m a) -> ((a -> m b) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a -> m b
c ->
        RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT ((a -> RouteT url m b) -> RouteT url m a
f (\a
a -> ((url -> [(Text, Maybe Text)] -> Text) -> m b) -> RouteT url m b
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url -> [(Text, Maybe Text)] -> Text) -> m b) -> RouteT url m b)
-> ((url -> [(Text, Maybe Text)] -> Text) -> m b) -> RouteT url m b
forall a b. (a -> b) -> a -> b
$ \url -> [(Text, Maybe Text)] -> Text
_ -> a -> m b
c a
a)) url -> [(Text, Maybe Text)] -> Text
url

instance (MonadError e m) => MonadError e (RouteT url m) where
  throwError :: e -> RouteT url m a
throwError = m a -> RouteT url m a
forall (m :: * -> *) a url. m a -> RouteT url m a
liftRouteT (m a -> RouteT url m a) -> (e -> m a) -> e -> RouteT url m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: RouteT url m a -> (e -> RouteT url m a) -> RouteT url m a
catchError RouteT url m a
action e -> RouteT url m a
handler = ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a)
-> ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall a b. (a -> b) -> a -> b
$ \url -> [(Text, Maybe Text)] -> Text
f -> m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT RouteT url m a
action url -> [(Text, Maybe Text)] -> Text
f) (\e
e -> RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT (e -> RouteT url m a
handler e
e) url -> [(Text, Maybe Text)] -> Text
f)

instance (MonadFix m) => MonadFix (RouteT url m) where
    mfix :: (a -> RouteT url m a) -> RouteT url m a
mfix a -> RouteT url m a
f = ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a)
-> ((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
forall a b. (a -> b) -> a -> b
$ \ url -> [(Text, Maybe Text)] -> Text
url -> (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((a -> m a) -> m a) -> (a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ a
a -> RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT (a -> RouteT url m a
f a
a) url -> [(Text, Maybe Text)] -> Text
url

instance (MonadIO m) => MonadIO (RouteT url m) where
  liftIO :: IO a -> RouteT url m a
liftIO = m a -> RouteT url m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RouteT url m a) -> (IO a -> m a) -> IO a -> RouteT url m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance (MonadReader r m) => MonadReader r (RouteT url m) where
  ask :: RouteT url m r
ask   = m r -> RouteT url m r
forall (m :: * -> *) a url. m a -> RouteT url m a
liftRouteT m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: (r -> r) -> RouteT url m a -> RouteT url m a
local r -> r
f = (m a -> m a) -> RouteT url m a -> RouteT url m a
forall (m :: * -> *) a (n :: * -> *) b url.
(m a -> n b) -> RouteT url m a -> RouteT url n b
mapRouteT ((r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f)

instance (MonadRWS r w s m) => MonadRWS r w s (RouteT url m)

instance (MonadState s m) => MonadState s (RouteT url m) where
  get :: RouteT url m s
get = m s -> RouteT url m s
forall (m :: * -> *) a url. m a -> RouteT url m a
liftRouteT m s
forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> RouteT url m ()
put s
s = m () -> RouteT url m ()
forall (m :: * -> *) a url. m a -> RouteT url m a
liftRouteT (m () -> RouteT url m ()) -> m () -> RouteT url m ()
forall a b. (a -> b) -> a -> b
$ s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s

instance MonadTrans (RouteT url) where
  lift :: m a -> RouteT url m a
lift = m a -> RouteT url m a
forall (m :: * -> *) a url. m a -> RouteT url m a
liftRouteT

instance (MonadWriter w m) => MonadWriter w (RouteT url m) where
  tell :: w -> RouteT url m ()
tell   w
w = m () -> RouteT url m ()
forall (m :: * -> *) a url. m a -> RouteT url m a
liftRouteT (m () -> RouteT url m ()) -> m () -> RouteT url m ()
forall a b. (a -> b) -> a -> b
$ w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell w
w
  listen :: RouteT url m a -> RouteT url m (a, w)
listen RouteT url m a
m = (m a -> m (a, w)) -> RouteT url m a -> RouteT url m (a, w)
forall (m :: * -> *) a (n :: * -> *) b url.
(m a -> n b) -> RouteT url m a -> RouteT url n b
mapRouteT m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen RouteT url m a
m
  pass :: RouteT url m (a, w -> w) -> RouteT url m a
pass   RouteT url m (a, w -> w)
m = (m (a, w -> w) -> m a)
-> RouteT url m (a, w -> w) -> RouteT url m a
forall (m :: * -> *) a (n :: * -> *) b url.
(m a -> n b) -> RouteT url m a -> RouteT url n b
mapRouteT m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass   RouteT url m (a, w -> w)
m

instance (Monad m) => MonadRoute (RouteT url m) where
    type URL (RouteT url m) = url
    askRouteFn :: RouteT url m (URL (RouteT url m) -> [(Text, Maybe Text)] -> Text)
askRouteFn = RouteT url m (URL (RouteT url m) -> [(Text, Maybe Text)] -> Text)
forall (m :: * -> *) url.
Monad m =>
RouteT url m (url -> [(Text, Maybe Text)] -> Text)
askRouteT

showURL :: (MonadRoute m) => URL m -> m Text
showURL :: URL m -> m Text
showURL URL m
url =
    do URL m -> [(Text, Maybe Text)] -> Text
showFn <- m (URL m -> [(Text, Maybe Text)] -> Text)
forall (m :: * -> *).
MonadRoute m =>
m (URL m -> [(Text, Maybe Text)] -> Text)
askRouteFn
       Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (URL m -> [(Text, Maybe Text)] -> Text
showFn URL m
url [])

showURLParams  :: (MonadRoute m) => URL m -> [(Text, Maybe Text)] -> m Text
showURLParams :: URL m -> [(Text, Maybe Text)] -> m Text
showURLParams URL m
url [(Text, Maybe Text)]
params =
    do URL m -> [(Text, Maybe Text)] -> Text
showFn <- m (URL m -> [(Text, Maybe Text)] -> Text)
forall (m :: * -> *).
MonadRoute m =>
m (URL m -> [(Text, Maybe Text)] -> Text)
askRouteFn
       Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (URL m -> [(Text, Maybe Text)] -> Text
showFn URL m
url [(Text, Maybe Text)]
params)

nestURL :: (url1 -> url2) -> RouteT url1 m a -> RouteT url2 m a
nestURL :: (url1 -> url2) -> RouteT url1 m a -> RouteT url2 m a
nestURL url1 -> url2
transform (RouteT (url1 -> [(Text, Maybe Text)] -> Text) -> m a
r) =
    do ((url2 -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url2 m a
forall url (m :: * -> *) a.
((url -> [(Text, Maybe Text)] -> Text) -> m a) -> RouteT url m a
RouteT (((url2 -> [(Text, Maybe Text)] -> Text) -> m a)
 -> RouteT url2 m a)
-> ((url2 -> [(Text, Maybe Text)] -> Text) -> m a)
-> RouteT url2 m a
forall a b. (a -> b) -> a -> b
$ \url2 -> [(Text, Maybe Text)] -> Text
showFn ->
           (url1 -> [(Text, Maybe Text)] -> Text) -> m a
r (\url1
url [(Text, Maybe Text)]
params -> url2 -> [(Text, Maybe Text)] -> Text
showFn (url1 -> url2
transform url1
url) [(Text, Maybe Text)]
params)