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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoutePath] -> ShowS
$cshowList :: [RoutePath] -> ShowS
show :: RoutePath -> String
$cshow :: RoutePath -> String
showsPrec :: Int -> RoutePath -> ShowS
$cshowsPrec :: Int -> RoutePath -> ShowS
Show, RoutePath -> RoutePath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RoutePath -> RoutePath -> Bool
$c/= :: RoutePath -> RoutePath -> Bool
== :: RoutePath -> RoutePath -> Bool
$c== :: RoutePath -> RoutePath -> Bool
Eq)
instance IsList RoutePath where
type Item RoutePath = Text
fromList :: [Item RoutePath] -> RoutePath
fromList = [Text] -> RoutePath
RoutePath
toList :: RoutePath -> [Item RoutePath]
toList (RoutePath [Text]
ps) = [Text]
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Description -> Description -> Bool
$c/= :: Description -> Description -> Bool
== :: Description -> Description -> Bool
$c== :: Description -> Description -> Bool
Eq, Eq 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
min :: Description -> Description -> Description
$cmin :: Description -> Description -> Description
max :: Description -> Description -> Description
$cmax :: Description -> Description -> Description
>= :: Description -> Description -> Bool
$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
compare :: Description -> Description -> Ordering
$ccompare :: Description -> Description -> Ordering
Ord, Int -> Description -> ShowS
[Description] -> ShowS
Description -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Description] -> ShowS
$cshowList :: [Description] -> ShowS
show :: Description -> String
$cshow :: Description -> String
showsPrec :: Int -> Description -> ShowS
$cshowsPrec :: Int -> Description -> ShowS
Show, ReadPrec [Description]
ReadPrec Description
Int -> ReadS Description
ReadS [Description]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Description]
$creadListPrec :: ReadPrec [Description]
readPrec :: ReadPrec Description
$creadPrec :: ReadPrec Description
readList :: ReadS [Description]
$creadList :: ReadS [Description]
readsPrec :: Int -> ReadS Description
$creadsPrec :: Int -> ReadS Description
Read)
deriving newtype (String -> Description
forall a. (String -> a) -> IsString a
fromString :: String -> Description
$cfromString :: String -> Description
IsString)
newtype Summary = Summary {Summary -> Text
getSummary :: Text}
deriving stock (Summary -> Summary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Summary -> Summary -> Bool
$c/= :: Summary -> Summary -> Bool
== :: Summary -> Summary -> Bool
$c== :: Summary -> Summary -> Bool
Eq, Eq 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
min :: Summary -> Summary -> Summary
$cmin :: Summary -> Summary -> Summary
max :: Summary -> Summary -> Summary
$cmax :: Summary -> Summary -> Summary
>= :: Summary -> Summary -> Bool
$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
compare :: Summary -> Summary -> Ordering
$ccompare :: Summary -> Summary -> Ordering
Ord, Int -> Summary -> ShowS
[Summary] -> ShowS
Summary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Summary] -> ShowS
$cshowList :: [Summary] -> ShowS
show :: Summary -> String
$cshow :: Summary -> String
showsPrec :: Int -> Summary -> ShowS
$cshowsPrec :: Int -> Summary -> ShowS
Show, ReadPrec [Summary]
ReadPrec Summary
Int -> ReadS Summary
ReadS [Summary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Summary]
$creadListPrec :: ReadPrec [Summary]
readPrec :: ReadPrec Summary
$creadPrec :: ReadPrec Summary
readList :: ReadS [Summary]
$creadList :: ReadS [Summary]
readsPrec :: Int -> ReadS Summary
$creadsPrec :: Int -> ReadS Summary
Read)
deriving newtype (String -> Summary
forall a. (String -> a) -> IsString a
fromString :: String -> Summary
$cfromString :: String -> Summary
IsString)
data RouteMismatch = RouteMismatch
deriving stock (Int -> RouteMismatch -> ShowS
[RouteMismatch] -> ShowS
RouteMismatch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RouteMismatch] -> ShowS
$cshowList :: [RouteMismatch] -> ShowS
show :: RouteMismatch -> String
$cshow :: RouteMismatch -> String
showsPrec :: Int -> RouteMismatch -> ShowS
$cshowsPrec :: Int -> RouteMismatch -> ShowS
Show, RouteMismatch -> RouteMismatch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RouteMismatch -> RouteMismatch -> Bool
$c/= :: RouteMismatch -> RouteMismatch -> Bool
== :: RouteMismatch -> RouteMismatch -> Bool
$c== :: RouteMismatch -> RouteMismatch -> Bool
Eq, Eq 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
min :: RouteMismatch -> RouteMismatch -> RouteMismatch
$cmin :: RouteMismatch -> RouteMismatch -> RouteMismatch
max :: RouteMismatch -> RouteMismatch -> RouteMismatch
$cmax :: RouteMismatch -> RouteMismatch -> RouteMismatch
>= :: RouteMismatch -> RouteMismatch -> Bool
$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
compare :: RouteMismatch -> RouteMismatch -> Ordering
$ccompare :: RouteMismatch -> RouteMismatch -> Ordering
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 -> 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 = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr 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 (<-<) #-}