module Web.Route.Invertible.Result
( RouteResult(..)
, routeResult
) where
import qualified Data.ByteString.Char8 as BSC
import Data.Typeable (Typeable)
import Network.HTTP.Types.Header (ResponseHeaders, hAllow)
import Network.HTTP.Types.Status (Status, notFound404, methodNotAllowed405, internalServerError500)
import Web.Route.Invertible.Parameter
import Web.Route.Invertible.Method
data RouteResult a
= RouteNotFound
| AllowedMethods [Method]
| RouteResult a
| MultipleRoutes
deriving (RouteResult a -> RouteResult a -> Bool
(RouteResult a -> RouteResult a -> Bool)
-> (RouteResult a -> RouteResult a -> Bool) -> Eq (RouteResult a)
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
[RouteResult a] -> ShowS
RouteResult a -> String
(Int -> RouteResult a -> ShowS)
-> (RouteResult a -> String)
-> ([RouteResult a] -> ShowS)
-> Show (RouteResult a)
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, Typeable)
instance Functor RouteResult where
fmap :: (a -> b) -> RouteResult a -> RouteResult b
fmap a -> b
_ RouteResult a
RouteNotFound = RouteResult b
forall a. RouteResult a
RouteNotFound
fmap a -> b
_ (AllowedMethods [Method]
m) = [Method] -> RouteResult b
forall a. [Method] -> RouteResult a
AllowedMethods [Method]
m
fmap a -> b
f (RouteResult a
x) = b -> RouteResult b
forall a. a -> RouteResult a
RouteResult (a -> b
f a
x)
fmap a -> b
_ RouteResult a
MultipleRoutes = RouteResult b
forall a. RouteResult a
MultipleRoutes
instance Semigroup (RouteResult a) where
RouteResult a
RouteNotFound <> :: RouteResult a -> RouteResult a -> RouteResult a
<> RouteResult a
r = RouteResult a
r
AllowedMethods [Method]
_ <> r :: RouteResult a
r@(RouteResult a
_) = RouteResult a
r
AllowedMethods [Method]
a <> AllowedMethods [Method]
b = [Method] -> RouteResult a
forall a. [Method] -> RouteResult a
AllowedMethods ([Method] -> RouteResult a) -> [Method] -> RouteResult a
forall a b. (a -> b) -> a -> b
$ [Method] -> [Method] -> [Method]
forall a. Ord a => [a] -> [a] -> [a]
unionSorted [Method]
a [Method]
b
r :: RouteResult a
r@(RouteResult a
_) <> AllowedMethods [Method]
_ = RouteResult a
r
RouteResult a
MultipleRoutes <> RouteResult a
_ = RouteResult a
forall a. RouteResult a
MultipleRoutes
RouteResult a
r <> RouteResult a
RouteNotFound = RouteResult a
r
RouteResult a
_ <> RouteResult a
_ = RouteResult a
forall a. RouteResult a
MultipleRoutes
instance Monoid (RouteResult a) where
mempty :: RouteResult a
mempty = RouteResult a
forall a. RouteResult a
RouteNotFound
mappend :: RouteResult a -> RouteResult a -> RouteResult a
mappend = RouteResult a -> RouteResult a -> RouteResult a
forall a. Semigroup a => a -> a -> a
(<>)
unionSorted :: Ord a => [a] -> [a] -> [a]
unionSorted :: [a] -> [a] -> [a]
unionSorted al :: [a]
al@(a
a:[a]
ar) bl :: [a]
bl@(a
b:[a]
br) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b of
Ordering
LT -> a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
unionSorted [a]
ar [a]
bl
Ordering
EQ -> a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
unionSorted [a]
ar [a]
br
Ordering
GT -> a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
unionSorted [a]
al [a]
br
unionSorted [] [a]
l = [a]
l
unionSorted [a]
l [] = [a]
l
routeResult :: RouteResult a -> Either (Status, ResponseHeaders) a
routeResult :: RouteResult a -> Either (Status, ResponseHeaders) a
routeResult RouteResult a
RouteNotFound = (Status, ResponseHeaders) -> Either (Status, ResponseHeaders) a
forall a b. a -> Either a b
Left (Status
notFound404, [])
routeResult (AllowedMethods [Method]
m) = (Status, ResponseHeaders) -> Either (Status, ResponseHeaders) a
forall a b. a -> Either a b
Left (Status
methodNotAllowed405, [(HeaderName
hAllow, ByteString -> [ByteString] -> ByteString
BSC.intercalate (Char -> ByteString
BSC.singleton Char
',') ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Method -> ByteString) -> [Method] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Method -> ByteString
forall s a. Parameter s a => a -> s
renderParameter [Method]
m)])
routeResult (RouteResult a
a) = a -> Either (Status, ResponseHeaders) a
forall a b. b -> Either a b
Right a
a
routeResult RouteResult a
MultipleRoutes = (Status, ResponseHeaders) -> Either (Status, ResponseHeaders) a
forall a b. a -> Either a b
Left (Status
internalServerError500, [])