{-# LANGUAGE UndecidableInstances #-}

{-| Creation of routes from functions. A route is a handler function
for single path of the server.
-}
module Mig.Core.Class.Route (
  Route (..),
  ToRoute (..),
  toRoute,
) where

import Control.Monad.IO.Class
import Data.OpenApi (ToParamSchema (..), ToSchema (..))
import Data.Proxy
import Data.String
import GHC.TypeLits
import Mig.Core.Class.MediaType
import Mig.Core.Class.Monad
import Mig.Core.Class.Response (IsResp (..))
import Mig.Core.ServerFun
import Mig.Core.Types
import Web.HttpApiData

{-| Values that represent routes.
A route is a function of arbitrary number of arguments. Where
each argument is one of the special newtype-wrappers that
read type-safe information from HTTP-request and return type of the route function
is a value of something convertible to HTTP-request.
-}
class (MonadIO (MonadOf a)) => ToRoute a where
  -- | Update API info
  toRouteInfo :: RouteInfo -> RouteInfo

  -- | Convert to route
  toRouteFun :: a -> ServerFun (MonadOf a)

-- | Route contains API-info and how to run it
data Route m = Route
  { forall (m :: * -> *). Route m -> RouteInfo
info :: RouteInfo
  -- ^ definition of the API (to use it in OpenApi or clients)
  , forall (m :: * -> *). Route m -> ServerFun m
run :: ServerFun m
  -- ^ how to run a server
  }

-- | converts route-like value to route.
toRoute :: forall a. (ToRoute a) => a -> Route (MonadOf a)
toRoute :: forall a. ToRoute a => a -> Route (MonadOf a)
toRoute a
a =
  Route
    { $sel:info:Route :: RouteInfo
info = forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @a RouteInfo
emptyRouteInfo
    , $sel:run:Route :: ServerFun (MonadOf a)
run = forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun a
a
    }

-------------------------------------------------------------------------------------
-- identity instances

instance (MonadIO m) => ToRoute (Route m) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall a. a -> a
id
  toRouteFun :: Route m -> ServerFun (MonadOf (Route m))
toRouteFun = (.run)

-------------------------------------------------------------------------------------
-- request inputs

instance (ToSchema a, FromReqBody media a, ToRoute b) => ToRoute (Body media a -> b) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall {k} (ty :: k) a.
(ToMediaType ty, ToSchema a) =>
RouteInfo -> RouteInfo
addBodyInfo @media @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @b
  toRouteFun :: (Body media a -> b) -> ServerFun (MonadOf (Body media a -> b))
toRouteFun Body media a -> b
f = forall {k} (media :: k) a (m :: * -> *).
(MonadIO m, FromReqBody media a) =>
(a -> ServerFun m) -> ServerFun m
withBody @media (forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body media a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (media :: k) a. a -> Body media a
Body)

instance (FromHttpApiData a, ToParamSchema a, ToRoute b, KnownSymbol sym) => ToRoute (Query sym a -> b) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addQueryInfo @sym @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @b
  toRouteFun :: (Query sym a -> b) -> ServerFun (MonadOf (Query sym a -> b))
toRouteFun Query sym a -> b
f = forall (m :: * -> *) a.
(Monad m, FromHttpApiData a) =>
Text -> (a -> ServerFun m) -> ServerFun m
withQuery (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query sym a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sym :: Symbol) a. a -> Query sym a
Query)

instance (FromHttpApiData a, ToParamSchema a, ToRoute b, KnownSymbol sym) => ToRoute (Optional sym a -> b) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addOptionalInfo @sym @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @b
  toRouteFun :: (Optional sym a -> b) -> ServerFun (MonadOf (Optional sym a -> b))
toRouteFun Optional sym a -> b
f = forall a (m :: * -> *).
FromHttpApiData a =>
Text -> (Maybe a -> ServerFun m) -> ServerFun m
withOptional (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optional sym a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sym :: Symbol) a. Maybe a -> Optional sym a
Optional)

instance (ToRoute b, KnownSymbol sym) => ToRoute (QueryFlag sym -> b) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall (sym :: Symbol). KnownSymbol sym => RouteInfo -> RouteInfo
addQueryFlagInfo @sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @b
  toRouteFun :: (QueryFlag sym -> b) -> ServerFun (MonadOf (QueryFlag sym -> b))
toRouteFun QueryFlag sym -> b
f = forall (m :: * -> *). Text -> (Bool -> ServerFun m) -> ServerFun m
withQueryFlag (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryFlag sym -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sym :: Symbol). Bool -> QueryFlag sym
QueryFlag)

instance (FromHttpApiData a, ToParamSchema a, ToRoute b, KnownSymbol sym) => ToRoute (Capture sym a -> b) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addCaptureInfo @sym @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @b
  toRouteFun :: (Capture sym a -> b) -> ServerFun (MonadOf (Capture sym a -> b))
toRouteFun Capture sym a -> b
f = forall (m :: * -> *) a.
(Monad m, FromHttpApiData a) =>
Text -> (a -> ServerFun m) -> ServerFun m
withCapture (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capture sym a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sym :: Symbol) a. a -> Capture sym a
Capture)

instance (FromHttpApiData a, ToParamSchema a, ToRoute b, KnownSymbol sym) => ToRoute (Header sym a -> b) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addHeaderInfo @sym @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @b
  toRouteFun :: (Header sym a -> b) -> ServerFun (MonadOf (Header sym a -> b))
toRouteFun Header sym a -> b
f = forall (m :: * -> *) a.
(Monad m, FromHttpApiData a) =>
HeaderName -> (a -> ServerFun m) -> ServerFun m
withHeader (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header sym a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sym :: Symbol) a. a -> Header sym a
Header)

instance (FromHttpApiData a, ToParamSchema a, ToRoute b, KnownSymbol sym) => ToRoute (OptionalHeader sym a -> b) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addOptionalHeaderInfo @sym @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @b
  toRouteFun :: (OptionalHeader sym a -> b)
-> ServerFun (MonadOf (OptionalHeader sym a -> b))
toRouteFun OptionalHeader sym a -> b
f = forall a (m :: * -> *).
FromHttpApiData a =>
HeaderName -> (Maybe a -> ServerFun m) -> ServerFun m
withOptionalHeader (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionalHeader sym a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sym :: Symbol) a. Maybe a -> OptionalHeader sym a
OptionalHeader)

instance (ToRoute b) => ToRoute (PathInfo -> b) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @b
  toRouteFun :: (PathInfo -> b) -> ServerFun (MonadOf (PathInfo -> b))
toRouteFun PathInfo -> b
f = forall (m :: * -> *). ([Text] -> ServerFun m) -> ServerFun m
withPathInfo (forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathInfo -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> PathInfo
PathInfo)

instance (ToRoute b) => ToRoute (FullPathInfo -> b) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @b
  toRouteFun :: (FullPathInfo -> b) -> ServerFun (MonadOf (FullPathInfo -> b))
toRouteFun FullPathInfo -> b
f = forall (m :: * -> *). (Text -> ServerFun m) -> ServerFun m
withFullPathInfo (forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. FullPathInfo -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FullPathInfo
FullPathInfo)

instance (ToRoute b) => ToRoute (RawRequest -> b) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @b
  toRouteFun :: (RawRequest -> b) -> ServerFun (MonadOf (RawRequest -> b))
toRouteFun RawRequest -> b
f = \Request
req -> forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun (RawRequest -> b
f (Request -> RawRequest
RawRequest Request
req)) Request
req

instance (ToRoute b) => ToRoute (IsSecure -> b) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @b
  toRouteFun :: (IsSecure -> b) -> ServerFun (MonadOf (IsSecure -> b))
toRouteFun IsSecure -> b
f = \Request
req -> forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun (IsSecure -> b
f (Bool -> IsSecure
IsSecure Request
req.isSecure)) Request
req

-------------------------------------------------------------------------------------
-- outputs

instance {-# OVERLAPPABLE #-} (MonadIO m, IsResp a, IsMethod method) => ToRoute (Send method m a) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = ByteString -> MediaType -> RouteInfo -> RouteInfo
setMethod (forall {k} (a :: k). IsMethod a => ByteString
toMethod @method) (forall a. IsResp a => MediaType
getMedia @a)
  toRouteFun :: Send method m a -> ServerFun (MonadOf (Send method m a))
toRouteFun (Send m a
a) = forall (m :: * -> *). Functor m => m Response -> ServerFun m
sendResponse forall a b. (a -> b) -> a -> b
$ forall a. IsResp a => a -> Response
toResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
a

---------------------------------------------
-- utils

getName :: forall sym a. (KnownSymbol sym, IsString a) => a
getName :: forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName = forall a. IsString a => String -> a
fromString (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @sym))