{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE NoFieldSelectors #-}

module Okapi.Mode.Link (
    URI (..),
    Link (..),
    GLink,
    links,
) where

import Data.Kind (Type)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8)
import GHC.Generics
    ( D1, C1, S1, K1 (..), M1 (..), Rec0
    , Generic (..), Rep
    , (:*:) (..)
    )
import GHC.Records (HasField (..))
import Network.HTTP.Types qualified as HTTP
import Okapi.Mode.Forest (Forest (..), Shape)
import Okapi.HTTP.Request.Path qualified as Path
import Okapi.HTTP.Request.Query qualified as Query
import Okapi.Record.Tree qualified as Tree

data URI = URI
    { URI -> Text
path  :: Text
    , URI -> Text
query :: Text
    }

instance HasField "full" URI Text where
    getField :: URI -> Text
getField URI
u = URI
u.path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> URI
u.query

data Link shape where
    Link ::
        (path -> query -> URI) ->
        Link (Shape method path query headers body result)

buildURI ::
    Tree.Request method path query headers body ->
    path ->
    query ->
    URI
buildURI :: forall method path query headers body.
Request method path query headers body -> path -> query -> URI
buildURI Request method path query headers body
req path
pathVal query
queryVal = URI
    { path :: Text
path  = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"/" (Tree Path path path -> Printer Path path
forall i o. Tree Path i o -> Printer Path i
Path.printer Request method path query headers body
req.path path
pathVal)
    , query :: Text
query = ByteString -> Text
decodeUtf8 (Bool -> Query -> ByteString
HTTP.renderQuery Bool
True (Tree Query query query -> Printer Query query
forall i o. Tree Query i o -> Printer Query i
Query.printer Request method path query headers body
req.query query
queryVal))
    }

class GLink (epF :: Type -> Type) (lnF :: Type -> Type) where
    gLink :: epF () -> lnF ()

instance GLink epF lnF => GLink (D1 dm epF) (D1 dm' lnF) where
    gLink :: D1 dm epF () -> D1 dm' lnF ()
gLink (M1 epF ()
ep) = lnF () -> D1 dm' lnF ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall (epF :: * -> *) (lnF :: * -> *).
GLink epF lnF =>
epF () -> lnF ()
gLink @epF @lnF epF ()
ep)

instance GLink epF lnF => GLink (C1 cm epF) (C1 cm' lnF) where
    gLink :: C1 cm epF () -> C1 cm' lnF ()
gLink (M1 epF ()
ep) = lnF () -> C1 cm' lnF ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall (epF :: * -> *) (lnF :: * -> *).
GLink epF lnF =>
epF () -> lnF ()
gLink @epF @lnF epF ()
ep)

instance (GLink epL lnL, GLink epR lnR) => GLink (epL :*: epR) (lnL :*: lnR) where
    gLink :: (:*:) epL epR () -> (:*:) lnL lnR ()
gLink (epL ()
epL :*: epR ()
epR) = forall (epF :: * -> *) (lnF :: * -> *).
GLink epF lnF =>
epF () -> lnF ()
gLink @epL @lnL epL ()
epL lnL () -> lnR () -> (:*:) lnL lnR ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (epF :: * -> *) (lnF :: * -> *).
GLink epF lnF =>
epF () -> lnF ()
gLink @epR @lnR epR ()
epR

instance GLink
    (S1 sm  (Rec0 (Forest (Shape method path query headers body result))))
    (S1 sm' (Rec0 (Link (Shape method path query headers body result)))) where
    gLink :: S1
  sm (Rec0 (Forest (Shape method path query headers body result))) ()
-> S1
     sm' (Rec0 (Link (Shape method path query headers body result))) ()
gLink (M1 (K1 Forest (Shape method path query headers body result)
ep)) = Rec0 (Link (Shape method path query headers body result)) ()
-> S1
     sm' (Rec0 (Link (Shape method path query headers body result))) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Link (Shape method path query headers body result)
-> Rec0 (Link (Shape method path query headers body result)) ()
forall k i c (p :: k). c -> K1 i c p
K1 (case Forest (Shape method path query headers body result)
ep of
        (Request method path query headers body
req :-> Response status resHeaders resBody
_) -> (path -> query -> URI)
-> Link (Shape method path query headers body result)
forall path query method headers body result.
(path -> query -> URI)
-> Link (Shape method path query headers body result)
Link (Request method path query headers body -> path -> query -> URI
forall method path query headers body.
Request method path query headers body -> path -> query -> URI
buildURI Request method path query headers body
Request method path query headers body
req)
        (Request method path query headers body
req :-< Responses Response responses
_) -> (path -> query -> URI)
-> Link (Shape method path query headers body result)
forall path query method headers body result.
(path -> query -> URI)
-> Link (Shape method path query headers body result)
Link (Request method path query headers body -> path -> query -> URI
forall method path query headers body.
Request method path query headers body -> path -> query -> URI
buildURI Request method path query headers body
Request method path query headers body
req)))

links ::
    forall server.
    ( Generic (server Forest)
    , Generic (server Link)
    , GLink (Rep (server Forest)) (Rep (server Link))
    ) =>
    server Forest ->
    server Link
links :: forall (server :: (* -> *) -> *).
(Generic (server Forest), Generic (server Link),
 GLink (Rep (server Forest)) (Rep (server Link))) =>
server Forest -> server Link
links server Forest
endpoints =
    Rep (server Link) () -> server Link
forall a x. Generic a => Rep a x -> a
forall x. Rep (server Link) x -> server Link
to (forall (epF :: * -> *) (lnF :: * -> *).
GLink epF lnF =>
epF () -> lnF ()
gLink @(Rep (server Forest)) @(Rep (server Link)) (server Forest -> Rep (server Forest) ()
forall x. server Forest -> Rep (server Forest) x
forall a x. Generic a => a -> Rep a x
from server Forest
endpoints))