module WebGear.Core.Handler (
Handler (..),
RoutePath (..),
RouteMismatch (..),
Description (..),
Summary (..),
RequestHandler,
Middleware,
routeMismatch,
unwitnessA,
(>->),
(<-<),
) where
import Control.Arrow (Arrow, ArrowChoice, ArrowPlus, arr)
import Control.Arrow.Operations (ArrowError (..))
import Data.String (IsString)
import Data.Text (Text)
import GHC.Exts (IsList (..))
import WebGear.Core.Request (Request)
import WebGear.Core.Response (Response (..))
import WebGear.Core.Trait (With (unwitness))
newtype RoutePath = RoutePath [Text]
deriving newtype (Int -> RoutePath -> ShowS
[RoutePath] -> ShowS
RoutePath -> String
(Int -> RoutePath -> ShowS)
-> (RoutePath -> String)
-> ([RoutePath] -> ShowS)
-> Show RoutePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RoutePath -> ShowS
showsPrec :: Int -> RoutePath -> ShowS
$cshow :: RoutePath -> String
show :: RoutePath -> String
$cshowList :: [RoutePath] -> ShowS
showList :: [RoutePath] -> ShowS
Show, RoutePath -> RoutePath -> Bool
(RoutePath -> RoutePath -> Bool)
-> (RoutePath -> RoutePath -> Bool) -> Eq RoutePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RoutePath -> RoutePath -> Bool
== :: RoutePath -> RoutePath -> Bool
$c/= :: RoutePath -> RoutePath -> Bool
/= :: RoutePath -> RoutePath -> Bool
Eq)
instance IsList RoutePath where
type Item RoutePath = Text
fromList :: [Item RoutePath] -> RoutePath
fromList = [Text] -> RoutePath
[Item RoutePath] -> RoutePath
RoutePath
toList :: RoutePath -> [Item RoutePath]
toList (RoutePath [Text]
ps) = [Text]
[Item RoutePath]
ps
class (ArrowChoice h, ArrowPlus h, ArrowError RouteMismatch h, Monad m) => Handler h m | h -> m where
arrM :: (a -> m b) -> h a b
consumeRoute :: h RoutePath a -> h () a
setDescription :: Description -> h a a
setSummary :: Summary -> h a a
type RequestHandler h ts = h (Request `With` ts) Response
type Middleware h tsOut tsIn = RequestHandler h tsIn -> RequestHandler h tsOut
newtype Description = Description {Description -> Text
getDescription :: Text}
deriving stock (Description -> Description -> Bool
(Description -> Description -> Bool)
-> (Description -> Description -> Bool) -> Eq Description
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Description -> Description -> Bool
== :: Description -> Description -> Bool
$c/= :: Description -> Description -> Bool
/= :: Description -> Description -> Bool
Eq, Eq Description
Eq Description =>
(Description -> Description -> Ordering)
-> (Description -> Description -> Bool)
-> (Description -> Description -> Bool)
-> (Description -> Description -> Bool)
-> (Description -> Description -> Bool)
-> (Description -> Description -> Description)
-> (Description -> Description -> Description)
-> Ord Description
Description -> Description -> Bool
Description -> Description -> Ordering
Description -> Description -> Description
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
$ccompare :: Description -> Description -> Ordering
compare :: Description -> Description -> Ordering
$c< :: Description -> Description -> Bool
< :: Description -> Description -> Bool
$c<= :: Description -> Description -> Bool
<= :: Description -> Description -> Bool
$c> :: Description -> Description -> Bool
> :: Description -> Description -> Bool
$c>= :: Description -> Description -> Bool
>= :: Description -> Description -> Bool
$cmax :: Description -> Description -> Description
max :: Description -> Description -> Description
$cmin :: Description -> Description -> Description
min :: Description -> Description -> Description
Ord, Int -> Description -> ShowS
[Description] -> ShowS
Description -> String
(Int -> Description -> ShowS)
-> (Description -> String)
-> ([Description] -> ShowS)
-> Show Description
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Description -> ShowS
showsPrec :: Int -> Description -> ShowS
$cshow :: Description -> String
show :: Description -> String
$cshowList :: [Description] -> ShowS
showList :: [Description] -> ShowS
Show, ReadPrec [Description]
ReadPrec Description
Int -> ReadS Description
ReadS [Description]
(Int -> ReadS Description)
-> ReadS [Description]
-> ReadPrec Description
-> ReadPrec [Description]
-> Read Description
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Description
readsPrec :: Int -> ReadS Description
$creadList :: ReadS [Description]
readList :: ReadS [Description]
$creadPrec :: ReadPrec Description
readPrec :: ReadPrec Description
$creadListPrec :: ReadPrec [Description]
readListPrec :: ReadPrec [Description]
Read)
deriving newtype (String -> Description
(String -> Description) -> IsString Description
forall a. (String -> a) -> IsString a
$cfromString :: String -> Description
fromString :: String -> Description
IsString)
newtype Summary = Summary {Summary -> Text
getSummary :: Text}
deriving stock (Summary -> Summary -> Bool
(Summary -> Summary -> Bool)
-> (Summary -> Summary -> Bool) -> Eq Summary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Summary -> Summary -> Bool
== :: Summary -> Summary -> Bool
$c/= :: Summary -> Summary -> Bool
/= :: Summary -> Summary -> Bool
Eq, Eq Summary
Eq Summary =>
(Summary -> Summary -> Ordering)
-> (Summary -> Summary -> Bool)
-> (Summary -> Summary -> Bool)
-> (Summary -> Summary -> Bool)
-> (Summary -> Summary -> Bool)
-> (Summary -> Summary -> Summary)
-> (Summary -> Summary -> Summary)
-> Ord Summary
Summary -> Summary -> Bool
Summary -> Summary -> Ordering
Summary -> Summary -> Summary
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
$ccompare :: Summary -> Summary -> Ordering
compare :: Summary -> Summary -> Ordering
$c< :: Summary -> Summary -> Bool
< :: Summary -> Summary -> Bool
$c<= :: Summary -> Summary -> Bool
<= :: Summary -> Summary -> Bool
$c> :: Summary -> Summary -> Bool
> :: Summary -> Summary -> Bool
$c>= :: Summary -> Summary -> Bool
>= :: Summary -> Summary -> Bool
$cmax :: Summary -> Summary -> Summary
max :: Summary -> Summary -> Summary
$cmin :: Summary -> Summary -> Summary
min :: Summary -> Summary -> Summary
Ord, Int -> Summary -> ShowS
[Summary] -> ShowS
Summary -> String
(Int -> Summary -> ShowS)
-> (Summary -> String) -> ([Summary] -> ShowS) -> Show Summary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Summary -> ShowS
showsPrec :: Int -> Summary -> ShowS
$cshow :: Summary -> String
show :: Summary -> String
$cshowList :: [Summary] -> ShowS
showList :: [Summary] -> ShowS
Show, ReadPrec [Summary]
ReadPrec Summary
Int -> ReadS Summary
ReadS [Summary]
(Int -> ReadS Summary)
-> ReadS [Summary]
-> ReadPrec Summary
-> ReadPrec [Summary]
-> Read Summary
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Summary
readsPrec :: Int -> ReadS Summary
$creadList :: ReadS [Summary]
readList :: ReadS [Summary]
$creadPrec :: ReadPrec Summary
readPrec :: ReadPrec Summary
$creadListPrec :: ReadPrec [Summary]
readListPrec :: ReadPrec [Summary]
Read)
deriving newtype (String -> Summary
(String -> Summary) -> IsString Summary
forall a. (String -> a) -> IsString a
$cfromString :: String -> Summary
fromString :: String -> Summary
IsString)
data RouteMismatch = RouteMismatch
deriving stock (Int -> RouteMismatch -> ShowS
[RouteMismatch] -> ShowS
RouteMismatch -> String
(Int -> RouteMismatch -> ShowS)
-> (RouteMismatch -> String)
-> ([RouteMismatch] -> ShowS)
-> Show RouteMismatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RouteMismatch -> ShowS
showsPrec :: Int -> RouteMismatch -> ShowS
$cshow :: RouteMismatch -> String
show :: RouteMismatch -> String
$cshowList :: [RouteMismatch] -> ShowS
showList :: [RouteMismatch] -> ShowS
Show, RouteMismatch -> RouteMismatch -> Bool
(RouteMismatch -> RouteMismatch -> Bool)
-> (RouteMismatch -> RouteMismatch -> Bool) -> Eq RouteMismatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RouteMismatch -> RouteMismatch -> Bool
== :: RouteMismatch -> RouteMismatch -> Bool
$c/= :: RouteMismatch -> RouteMismatch -> Bool
/= :: RouteMismatch -> RouteMismatch -> Bool
Eq, Eq RouteMismatch
Eq RouteMismatch =>
(RouteMismatch -> RouteMismatch -> Ordering)
-> (RouteMismatch -> RouteMismatch -> Bool)
-> (RouteMismatch -> RouteMismatch -> Bool)
-> (RouteMismatch -> RouteMismatch -> Bool)
-> (RouteMismatch -> RouteMismatch -> Bool)
-> (RouteMismatch -> RouteMismatch -> RouteMismatch)
-> (RouteMismatch -> RouteMismatch -> RouteMismatch)
-> Ord RouteMismatch
RouteMismatch -> RouteMismatch -> Bool
RouteMismatch -> RouteMismatch -> Ordering
RouteMismatch -> RouteMismatch -> RouteMismatch
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
$ccompare :: RouteMismatch -> RouteMismatch -> Ordering
compare :: RouteMismatch -> RouteMismatch -> Ordering
$c< :: RouteMismatch -> RouteMismatch -> Bool
< :: RouteMismatch -> RouteMismatch -> Bool
$c<= :: RouteMismatch -> RouteMismatch -> Bool
<= :: RouteMismatch -> RouteMismatch -> Bool
$c> :: RouteMismatch -> RouteMismatch -> Bool
> :: RouteMismatch -> RouteMismatch -> Bool
$c>= :: RouteMismatch -> RouteMismatch -> Bool
>= :: RouteMismatch -> RouteMismatch -> Bool
$cmax :: RouteMismatch -> RouteMismatch -> RouteMismatch
max :: RouteMismatch -> RouteMismatch -> RouteMismatch
$cmin :: RouteMismatch -> RouteMismatch -> RouteMismatch
min :: RouteMismatch -> RouteMismatch -> RouteMismatch
Ord)
instance Semigroup RouteMismatch where
RouteMismatch
RouteMismatch <> :: RouteMismatch -> RouteMismatch -> RouteMismatch
<> RouteMismatch
RouteMismatch = RouteMismatch
RouteMismatch
instance Monoid RouteMismatch where
mempty :: RouteMismatch
mempty = RouteMismatch
RouteMismatch
routeMismatch :: (ArrowError RouteMismatch h) => h a b
routeMismatch :: forall (h :: * -> * -> *) a b. ArrowError RouteMismatch h => h a b
routeMismatch = proc a
_a -> h RouteMismatch b
forall b. h RouteMismatch b
forall ex (a :: * -> * -> *) b. ArrowError ex a => a ex b
raise -< RouteMismatch
RouteMismatch
{-# INLINE routeMismatch #-}
unwitnessA :: (Handler h m) => h (Response `With` ts) Response
unwitnessA :: forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
Handler h m =>
h (With Response ts) Response
unwitnessA = (With Response ts -> Response) -> h (With Response ts) Response
forall b c. (b -> c) -> h b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr With Response ts -> Response
forall a (ts :: [*]). With a ts -> a
unwitness
{-# INLINE unwitnessA #-}
infixr 1 >->, <-<
(>->) :: (Arrow h) => h (env, stack) a -> h (env, (a, stack)) b -> h (env, stack) b
h (env, stack) a
f >-> :: forall (h :: * -> * -> *) env stack a b.
Arrow h =>
h (env, stack) a -> h (env, (a, stack)) b -> h (env, stack) b
>-> h (env, (a, stack)) b
g = proc (env
env, stack
stack) -> do
a
a <- h (env, stack) a
f -< (env
env, stack
stack)
h (env, (a, stack)) b
g -< (env
env, (a
a, stack
stack))
{-# INLINE (>->) #-}
(<-<) :: (Arrow h) => h (env, (a, stack)) b -> h (env, stack) a -> h (env, stack) b
h (env, (a, stack)) b
f <-< :: forall (h :: * -> * -> *) env a stack b.
Arrow h =>
h (env, (a, stack)) b -> h (env, stack) a -> h (env, stack) b
<-< h (env, stack) a
g = proc (env
env, stack
stack) -> do
a
a <- h (env, stack) a
g -< (env
env, stack
stack)
h (env, (a, stack)) b
f -< (env
env, (a
a, stack
stack))
{-# INLINE (<-<) #-}