{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
module Servant.Server.Internal.RouteResult where

import           Control.Monad
                 (ap, liftM)
import           Control.Monad.Base
                 (MonadBase (..))
import           Control.Monad.Catch
                 (MonadThrow (..))
import           Control.Monad.Trans
                 (MonadIO (..), MonadTrans (..))
import           Control.Monad.Trans.Control
                 (ComposeSt, MonadBaseControl (..), MonadTransControl (..),
                 defaultLiftBaseWith, defaultRestoreM)

import           Servant.Server.Internal.ServerError

-- | The result of matching against a path in the route tree.
data RouteResult a =
    Fail ServerError           -- ^ Keep trying other paths.
                               --   The 'ServantError' should only be 404, 405 or 406.
  | FailFatal !ServerError     -- ^ Don't try other paths.
  | Route !a
  deriving (RouteResult a -> RouteResult a -> Bool
forall a. Eq a => RouteResult a -> RouteResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RouteResult a -> RouteResult a -> Bool
$c/= :: forall a. Eq a => RouteResult a -> RouteResult a -> Bool
== :: RouteResult a -> RouteResult a -> Bool
$c== :: forall a. Eq a => RouteResult a -> RouteResult a -> Bool
Eq, Int -> RouteResult a -> ShowS
forall a. Show a => Int -> RouteResult a -> ShowS
forall a. Show a => [RouteResult a] -> ShowS
forall a. Show a => RouteResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RouteResult a] -> ShowS
$cshowList :: forall a. Show a => [RouteResult a] -> ShowS
show :: RouteResult a -> String
$cshow :: forall a. Show a => RouteResult a -> String
showsPrec :: Int -> RouteResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RouteResult a -> ShowS
Show, ReadPrec [RouteResult a]
ReadPrec (RouteResult a)
ReadS [RouteResult a]
forall a. Read a => ReadPrec [RouteResult a]
forall a. Read a => ReadPrec (RouteResult a)
forall a. Read a => Int -> ReadS (RouteResult a)
forall a. Read a => ReadS [RouteResult a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RouteResult a]
$creadListPrec :: forall a. Read a => ReadPrec [RouteResult a]
readPrec :: ReadPrec (RouteResult a)
$creadPrec :: forall a. Read a => ReadPrec (RouteResult a)
readList :: ReadS [RouteResult a]
$creadList :: forall a. Read a => ReadS [RouteResult a]
readsPrec :: Int -> ReadS (RouteResult a)
$creadsPrec :: forall a. Read a => Int -> ReadS (RouteResult a)
Read, forall a b. a -> RouteResult b -> RouteResult a
forall a b. (a -> b) -> RouteResult a -> RouteResult 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 -> RouteResult b -> RouteResult a
$c<$ :: forall a b. a -> RouteResult b -> RouteResult a
fmap :: forall a b. (a -> b) -> RouteResult a -> RouteResult b
$cfmap :: forall a b. (a -> b) -> RouteResult a -> RouteResult b
Functor)

instance Applicative RouteResult where
    pure :: forall a. a -> RouteResult a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: forall a b. RouteResult (a -> b) -> RouteResult a -> RouteResult b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad RouteResult where
    return :: forall a. a -> RouteResult a
return = forall a. a -> RouteResult a
Route
    Route a
a     >>= :: forall a b. RouteResult a -> (a -> RouteResult b) -> RouteResult b
>>= a -> RouteResult b
f = a -> RouteResult b
f a
a
    Fail ServerError
e      >>= a -> RouteResult b
_ = forall a. ServerError -> RouteResult a
Fail ServerError
e
    FailFatal ServerError
e >>= a -> RouteResult b
_ = forall a. ServerError -> RouteResult a
FailFatal ServerError
e

newtype RouteResultT m a = RouteResultT { forall (m :: * -> *) a. RouteResultT m a -> m (RouteResult a)
runRouteResultT :: m (RouteResult a) }
  deriving (forall a b. a -> RouteResultT m b -> RouteResultT m a
forall a b. (a -> b) -> RouteResultT m a -> RouteResultT m b
forall (m :: * -> *) a b.
Functor m =>
a -> RouteResultT m b -> RouteResultT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RouteResultT m a -> RouteResultT m 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 -> RouteResultT m b -> RouteResultT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> RouteResultT m b -> RouteResultT m a
fmap :: forall a b. (a -> b) -> RouteResultT m a -> RouteResultT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RouteResultT m a -> RouteResultT m b
Functor)

instance MonadTrans RouteResultT where
    lift :: forall (m :: * -> *) a. Monad m => m a -> RouteResultT m a
lift = forall (m :: * -> *) a. m (RouteResult a) -> RouteResultT m a
RouteResultT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. a -> RouteResult a
Route

instance (Functor m, Monad m) => Applicative (RouteResultT m) where
    pure :: forall a. a -> RouteResultT m a
pure  = forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: forall a b.
RouteResultT m (a -> b) -> RouteResultT m a -> RouteResultT m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Monad (RouteResultT m) where
    return :: forall a. a -> RouteResultT m a
return = forall (m :: * -> *) a. m (RouteResult a) -> RouteResultT m a
RouteResultT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> RouteResult a
Route
    RouteResultT m a
m >>= :: forall a b.
RouteResultT m a -> (a -> RouteResultT m b) -> RouteResultT m b
>>= a -> RouteResultT m b
k = forall (m :: * -> *) a. m (RouteResult a) -> RouteResultT m a
RouteResultT forall a b. (a -> b) -> a -> b
$ do
        RouteResult a
a <- forall (m :: * -> *) a. RouteResultT m a -> m (RouteResult a)
runRouteResultT RouteResultT m a
m
        case RouteResult a
a of
            Fail ServerError
e      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ServerError -> RouteResult a
Fail ServerError
e
            FailFatal ServerError
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ServerError -> RouteResult a
FailFatal ServerError
e
            Route a
b     -> forall (m :: * -> *) a. RouteResultT m a -> m (RouteResult a)
runRouteResultT (a -> RouteResultT m b
k a
b)

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

instance MonadBase b m => MonadBase b (RouteResultT m) where
    liftBase :: forall α. b α -> RouteResultT m α
liftBase = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance MonadBaseControl b m => MonadBaseControl b (RouteResultT m) where
    type StM (RouteResultT m) a = ComposeSt RouteResultT m a
    liftBaseWith :: forall a. (RunInBase (RouteResultT m) b -> b a) -> RouteResultT m a
liftBaseWith = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
    restoreM :: forall a. StM (RouteResultT m) a -> RouteResultT m a
restoreM     = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

instance MonadTransControl RouteResultT where
    type StT RouteResultT a = RouteResult a
    liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run RouteResultT -> m a) -> RouteResultT m a
liftWith Run RouteResultT -> m a
f = forall (m :: * -> *) a. m (RouteResult a) -> RouteResultT m a
RouteResultT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Run RouteResultT -> m a
f forall (m :: * -> *) a. RouteResultT m a -> m (RouteResult a)
runRouteResultT
    restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT RouteResultT a) -> RouteResultT m a
restoreT = forall (m :: * -> *) a. m (RouteResult a) -> RouteResultT m a
RouteResultT

instance MonadThrow m => MonadThrow (RouteResultT m) where
    throwM :: forall e a. Exception e => e -> RouteResultT m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM