module Web.Minion.Htmx.Headers where

import Data.Bool (bool)
import Data.List.NonEmpty qualified as Nel
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import Data.Text.Encoding qualified as Text.Encode
import Web.Minion.Args
import Web.Minion.Error
import Web.Minion.Introspect qualified as I
import Web.Minion.Request.Header
import Web.Minion.Router (Router' (..), ValueCombinator)

-- | Matches only `HX-Request:true`. Otherwise throws 'NoMatch' that causes trying another route
hxRequest :: (MonadThrow m, I.Introspection i I.Header Bool) => ValueCombinator i (WithHeader Required Strict m Bool) ts m
hxRequest :: forall (m :: * -> *) i ts.
(MonadThrow m, Introspection i 'Header Bool) =>
ValueCombinator i (WithHeader Required Strict m Bool) ts m
hxRequest = forall a presence parsing (m :: * -> *) ts i.
(Introspection i 'Header a, IsRequired presence,
 IsLenient parsing) =>
HeaderName
-> (MakeError -> [ByteString] -> m (Arg presence parsing a))
-> Router' i (ts :+ WithHeader presence parsing m a) m
-> Router' i ts m
Header @Bool @Required @Strict HeaderName
"HX-Request" \MakeError
_ -> m Bool -> m Bool -> Bool -> m Bool
forall a. a -> a -> Bool -> a
bool (NoMatch -> m Bool
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM NoMatch
NoMatch) (Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) (Bool -> m Bool)
-> ([ByteString] -> Bool) -> [ByteString] -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
"true" ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)

hxTarget ::
  (I.Introspection i I.Header Text, MonadThrow m) =>
  ValueCombinator i (WithHeader Optional Strict m Text) ts m
hxTarget :: forall i (m :: * -> *) ts.
(Introspection i 'Header Text, MonadThrow m) =>
ValueCombinator i (WithHeader Optional Strict m Text) ts m
hxTarget = HeaderName
-> (MakeError -> [ByteString] -> m (Maybe Text))
-> ValueCombinator i (WithHeader Optional Strict m Text) ts m
forall i a (m :: * -> *) ts.
Introspection i 'Header a =>
HeaderName
-> (MakeError -> [ByteString] -> m (Maybe a))
-> ValueCombinator i (WithHeader Optional Strict m a) ts m
header HeaderName
"HX-Target" (([ByteString] -> m (Maybe Text))
-> MakeError -> [ByteString] -> m (Maybe Text)
forall a b. a -> b -> a
const (([ByteString] -> m (Maybe Text))
 -> MakeError -> [ByteString] -> m (Maybe Text))
-> ([ByteString] -> m (Maybe Text))
-> MakeError
-> [ByteString]
-> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text))
-> ([ByteString] -> Maybe Text) -> [ByteString] -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
Text.Encode.decodeUtf8 (Maybe ByteString -> Maybe Text)
-> ([ByteString] -> Maybe ByteString) -> [ByteString] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe)

hxTarget' ::
  (I.Introspection i I.Header Text, MonadThrow m) =>
  ValueCombinator i (WithHeader Required Strict m Text) ts m
hxTarget' :: forall i (m :: * -> *) ts.
(Introspection i 'Header Text, MonadThrow m) =>
ValueCombinator i (WithHeader Required Strict m Text) ts m
hxTarget' = HeaderName
-> (MakeError -> NonEmpty ByteString -> m Text)
-> ValueCombinator i (WithHeader Required Strict m Text) ts m
forall i a (m :: * -> *) ts.
(Introspection i 'Header a, MonadThrow m) =>
HeaderName
-> (MakeError -> NonEmpty ByteString -> m a)
-> ValueCombinator i (WithHeader Required Strict m a) ts m
header' HeaderName
"HX-Target" ((NonEmpty ByteString -> m Text)
-> MakeError -> NonEmpty ByteString -> m Text
forall a b. a -> b -> a
const ((NonEmpty ByteString -> m Text)
 -> MakeError -> NonEmpty ByteString -> m Text)
-> (NonEmpty ByteString -> m Text)
-> MakeError
-> NonEmpty ByteString
-> m Text
forall a b. (a -> b) -> a -> b
$ Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text)
-> (NonEmpty ByteString -> Text) -> NonEmpty ByteString -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.Encode.decodeUtf8 (ByteString -> Text)
-> (NonEmpty ByteString -> ByteString)
-> NonEmpty ByteString
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ByteString -> ByteString
forall a. NonEmpty a -> a
Nel.head)

hxTrigger ::
  (I.Introspection i I.Header Text, MonadThrow m) =>
  ValueCombinator i (WithHeader Optional Strict m Text) ts m
hxTrigger :: forall i (m :: * -> *) ts.
(Introspection i 'Header Text, MonadThrow m) =>
ValueCombinator i (WithHeader Optional Strict m Text) ts m
hxTrigger = HeaderName
-> (MakeError -> [ByteString] -> m (Maybe Text))
-> ValueCombinator i (WithHeader Optional Strict m Text) ts m
forall i a (m :: * -> *) ts.
Introspection i 'Header a =>
HeaderName
-> (MakeError -> [ByteString] -> m (Maybe a))
-> ValueCombinator i (WithHeader Optional Strict m a) ts m
header HeaderName
"HX-Trigger" (([ByteString] -> m (Maybe Text))
-> MakeError -> [ByteString] -> m (Maybe Text)
forall a b. a -> b -> a
const (([ByteString] -> m (Maybe Text))
 -> MakeError -> [ByteString] -> m (Maybe Text))
-> ([ByteString] -> m (Maybe Text))
-> MakeError
-> [ByteString]
-> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text))
-> ([ByteString] -> Maybe Text) -> [ByteString] -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
Text.Encode.decodeUtf8 (Maybe ByteString -> Maybe Text)
-> ([ByteString] -> Maybe ByteString) -> [ByteString] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe)

hxTrigger' ::
  (I.Introspection i I.Header Text, MonadThrow m) =>
  ValueCombinator i (WithHeader Required Strict m Text) ts m
hxTrigger' :: forall i (m :: * -> *) ts.
(Introspection i 'Header Text, MonadThrow m) =>
ValueCombinator i (WithHeader Required Strict m Text) ts m
hxTrigger' = HeaderName
-> (MakeError -> NonEmpty ByteString -> m Text)
-> ValueCombinator i (WithHeader Required Strict m Text) ts m
forall i a (m :: * -> *) ts.
(Introspection i 'Header a, MonadThrow m) =>
HeaderName
-> (MakeError -> NonEmpty ByteString -> m a)
-> ValueCombinator i (WithHeader Required Strict m a) ts m
header' HeaderName
"HX-Trigger" ((NonEmpty ByteString -> m Text)
-> MakeError -> NonEmpty ByteString -> m Text
forall a b. a -> b -> a
const ((NonEmpty ByteString -> m Text)
 -> MakeError -> NonEmpty ByteString -> m Text)
-> (NonEmpty ByteString -> m Text)
-> MakeError
-> NonEmpty ByteString
-> m Text
forall a b. (a -> b) -> a -> b
$ Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text)
-> (NonEmpty ByteString -> Text) -> NonEmpty ByteString -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.Encode.decodeUtf8 (ByteString -> Text)
-> (NonEmpty ByteString -> ByteString)
-> NonEmpty ByteString
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ByteString -> ByteString
forall a. NonEmpty a -> a
Nel.head)

hxTriggerName ::
  (I.Introspection i I.Header Text, MonadThrow m) =>
  ValueCombinator i (WithHeader Optional Strict m Text) ts m
hxTriggerName :: forall i (m :: * -> *) ts.
(Introspection i 'Header Text, MonadThrow m) =>
ValueCombinator i (WithHeader Optional Strict m Text) ts m
hxTriggerName = HeaderName
-> (MakeError -> [ByteString] -> m (Maybe Text))
-> ValueCombinator i (WithHeader Optional Strict m Text) ts m
forall i a (m :: * -> *) ts.
Introspection i 'Header a =>
HeaderName
-> (MakeError -> [ByteString] -> m (Maybe a))
-> ValueCombinator i (WithHeader Optional Strict m a) ts m
header HeaderName
"HX-Trigger-Name" (([ByteString] -> m (Maybe Text))
-> MakeError -> [ByteString] -> m (Maybe Text)
forall a b. a -> b -> a
const (([ByteString] -> m (Maybe Text))
 -> MakeError -> [ByteString] -> m (Maybe Text))
-> ([ByteString] -> m (Maybe Text))
-> MakeError
-> [ByteString]
-> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text))
-> ([ByteString] -> Maybe Text) -> [ByteString] -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
Text.Encode.decodeUtf8 (Maybe ByteString -> Maybe Text)
-> ([ByteString] -> Maybe ByteString) -> [ByteString] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe)

hxTriggerName' ::
  (I.Introspection i I.Header Text, MonadThrow m) =>
  ValueCombinator i (WithHeader Required Strict m Text) ts m
hxTriggerName' :: forall i (m :: * -> *) ts.
(Introspection i 'Header Text, MonadThrow m) =>
ValueCombinator i (WithHeader Required Strict m Text) ts m
hxTriggerName' = HeaderName
-> (MakeError -> NonEmpty ByteString -> m Text)
-> ValueCombinator i (WithHeader Required Strict m Text) ts m
forall i a (m :: * -> *) ts.
(Introspection i 'Header a, MonadThrow m) =>
HeaderName
-> (MakeError -> NonEmpty ByteString -> m a)
-> ValueCombinator i (WithHeader Required Strict m a) ts m
header' HeaderName
"HX-Trigger-Name" ((NonEmpty ByteString -> m Text)
-> MakeError -> NonEmpty ByteString -> m Text
forall a b. a -> b -> a
const ((NonEmpty ByteString -> m Text)
 -> MakeError -> NonEmpty ByteString -> m Text)
-> (NonEmpty ByteString -> m Text)
-> MakeError
-> NonEmpty ByteString
-> m Text
forall a b. (a -> b) -> a -> b
$ Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text)
-> (NonEmpty ByteString -> Text) -> NonEmpty ByteString -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.Encode.decodeUtf8 (ByteString -> Text)
-> (NonEmpty ByteString -> ByteString)
-> NonEmpty ByteString
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ByteString -> ByteString
forall a. NonEmpty a -> a
Nel.head)

hxCurrentUrl ::
  (I.Introspection i I.Header Text, MonadThrow m) =>
  ValueCombinator i (WithHeader Optional Strict m Text) ts m
hxCurrentUrl :: forall i (m :: * -> *) ts.
(Introspection i 'Header Text, MonadThrow m) =>
ValueCombinator i (WithHeader Optional Strict m Text) ts m
hxCurrentUrl = HeaderName
-> (MakeError -> [ByteString] -> m (Maybe Text))
-> ValueCombinator i (WithHeader Optional Strict m Text) ts m
forall i a (m :: * -> *) ts.
Introspection i 'Header a =>
HeaderName
-> (MakeError -> [ByteString] -> m (Maybe a))
-> ValueCombinator i (WithHeader Optional Strict m a) ts m
header HeaderName
"HX-Current-URL" (([ByteString] -> m (Maybe Text))
-> MakeError -> [ByteString] -> m (Maybe Text)
forall a b. a -> b -> a
const (([ByteString] -> m (Maybe Text))
 -> MakeError -> [ByteString] -> m (Maybe Text))
-> ([ByteString] -> m (Maybe Text))
-> MakeError
-> [ByteString]
-> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text))
-> ([ByteString] -> Maybe Text) -> [ByteString] -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
Text.Encode.decodeUtf8 (Maybe ByteString -> Maybe Text)
-> ([ByteString] -> Maybe ByteString) -> [ByteString] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe)

hxCurrentUrl' ::
  (I.Introspection i I.Header Text, MonadThrow m) =>
  ValueCombinator i (WithHeader Required Strict m Text) ts m
hxCurrentUrl' :: forall i (m :: * -> *) ts.
(Introspection i 'Header Text, MonadThrow m) =>
ValueCombinator i (WithHeader Required Strict m Text) ts m
hxCurrentUrl' = HeaderName
-> (MakeError -> NonEmpty ByteString -> m Text)
-> ValueCombinator i (WithHeader Required Strict m Text) ts m
forall i a (m :: * -> *) ts.
(Introspection i 'Header a, MonadThrow m) =>
HeaderName
-> (MakeError -> NonEmpty ByteString -> m a)
-> ValueCombinator i (WithHeader Required Strict m a) ts m
header' HeaderName
"HX-Current-URL" ((NonEmpty ByteString -> m Text)
-> MakeError -> NonEmpty ByteString -> m Text
forall a b. a -> b -> a
const ((NonEmpty ByteString -> m Text)
 -> MakeError -> NonEmpty ByteString -> m Text)
-> (NonEmpty ByteString -> m Text)
-> MakeError
-> NonEmpty ByteString
-> m Text
forall a b. (a -> b) -> a -> b
$ Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text)
-> (NonEmpty ByteString -> Text) -> NonEmpty ByteString -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.Encode.decodeUtf8 (ByteString -> Text)
-> (NonEmpty ByteString -> ByteString)
-> NonEmpty ByteString
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ByteString -> ByteString
forall a. NonEmpty a -> a
Nel.head)