{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}

module Servant.HTMX where

import Data.Text
import Servant
import Servant.API
import Servant.Server

-- | Request headers (sent by the client to the server)
type HXRequest = Header "HX-Request" Text
type HXTriggerId = Header "HX-Trigger" Text
type HXTriggerName = Header "HX-Trigger-Name" Text
type HXTarget = Header "HX-Target" Text
type HXPrompt = Header "HX-Prompt" Text

-- | Response headers (sent by the server to the client)
type HXPush = Header "HX-Push" Text -- use safelinks
type HXRedirect = Header "HX-Redirect" Text -- use safelinks
type HXRefresh = Header "HX-Refresh" Text 
type HXTrigger = Header "HX-Trigger" Text
type HXTriggerAfterSwap = Header "HX-Trigger-After-Swap" Text
type HXTriggerAfterSettle = Header "HX-Trigger-After-Settle" Text

-- | Example usage of htmx header types
type ExampleAPI = HXRequest :> Get '[JSON] Text
                :<|> HXTriggerId :> Post '[JSON] Text
                :<|> "somePath" :> Get '[JSON] (Headers '[HXPush, HXRedirect] Text)

exampleServer :: Server ExampleAPI
exampleServer :: Server ExampleAPI
exampleServer = Maybe Text -> Handler Text
exampleGetHandler
              (Maybe Text -> Handler Text)
-> ((Maybe Text -> Handler Text)
    :<|> Handler (Headers '[HXPush, HXRedirect] Text))
-> (Maybe Text -> Handler Text)
   :<|> ((Maybe Text -> Handler Text)
         :<|> Handler (Headers '[HXPush, HXRedirect] Text))
forall a b. a -> b -> a :<|> b
:<|> Maybe Text -> Handler Text
examplePostHandler
              (Maybe Text -> Handler Text)
-> Handler (Headers '[HXPush, HXRedirect] Text)
-> (Maybe Text -> Handler Text)
   :<|> Handler (Headers '[HXPush, HXRedirect] Text)
forall a b. a -> b -> a :<|> b
:<|> Handler (Headers '[HXPush, HXRedirect] Text)
exampleSomePathHandler
  where
    exampleGetHandler :: Maybe Text -> Handler Text
    exampleGetHandler :: Maybe Text -> Handler Text
exampleGetHandler Maybe Text
mb = case Maybe Text
mb of
      Just Text
"true" -> Text -> Handler Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"The request was sent to the server by htmx" 
      Maybe Text
_ -> Text -> Handler Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"The request wasn't sent to the server by htmx" 

    examplePostHandler :: Maybe Text -> Handler Text
    examplePostHandler :: Maybe Text -> Handler Text
examplePostHandler Maybe Text
mb = case Maybe Text
mb of
      Just Text
"adminPanel" -> Text -> Handler Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"The request was triggered by the admin panel" 
      Maybe Text
_ -> Text -> Handler Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"The request wasn't triggered by the admin panel" 

    exampleSomePathHandler :: Handler (Headers '[HXPush, HXRedirect] Text)
    exampleSomePathHandler :: Handler (Headers '[HXPush, HXRedirect] Text)
exampleSomePathHandler = Headers '[HXPush, HXRedirect] Text
-> Handler (Headers '[HXPush, HXRedirect] Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Headers '[HXPush, HXRedirect] Text
 -> Handler (Headers '[HXPush, HXRedirect] Text))
-> Headers '[HXPush, HXRedirect] Text
-> Handler (Headers '[HXPush, HXRedirect] Text)
forall a b. (a -> b) -> a -> b
$ Headers '[HXRedirect] Text -> Headers '[HXPush, HXRedirect] Text
forall (h :: Symbol) v orig new.
AddHeader h v orig new =>
orig -> new
noHeader (Headers '[HXRedirect] Text -> Headers '[HXPush, HXRedirect] Text)
-> Headers '[HXRedirect] Text -> Headers '[HXPush, HXRedirect] Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Headers '[HXRedirect] Text
forall (h :: Symbol) v orig new.
AddHeader h v orig new =>
v -> orig -> new
addHeader Text
"someURLForRedirect" Text
"This response has htmx headers" 

exampleApp :: Application
exampleApp :: Application
exampleApp = Proxy ExampleAPI -> Server ExampleAPI -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (Proxy ExampleAPI
forall k (t :: k). Proxy t
Proxy :: Proxy ExampleAPI) Server ExampleAPI
exampleServer