{-# LANGUAGE TemplateHaskell #-}

module Dashi.Components.Util where

import Dashi.Prelude
import Dashi.Style.Tokens (Appearance, Token (..))
import Data.List qualified as List
import Miso.Html.Property (aria_, tabindex_)
import Miso.JSON qualified as JSON
import Miso.String qualified as MisoString

makePrisms ''Attribute

props :: [Attribute action] -> [(MisoString, JSON.Value)]
props :: forall action. [Attribute action] -> [(MisoString, Value)]
props = Getting
  (Endo [(MisoString, Value)]) [Attribute action] (MisoString, Value)
-> [Attribute action] -> [(MisoString, Value)]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Getting
   (Endo [(MisoString, Value)]) [Attribute action] (MisoString, Value)
 -> [Attribute action] -> [(MisoString, Value)])
-> Getting
     (Endo [(MisoString, Value)]) [Attribute action] (MisoString, Value)
-> [Attribute action]
-> [(MisoString, Value)]
forall a b. (a -> b) -> a -> b
$ (Attribute action
 -> Const (Endo [(MisoString, Value)]) (Attribute action))
-> [Attribute action]
-> Const (Endo [(MisoString, Value)]) [Attribute action]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Attribute action
  -> Const (Endo [(MisoString, Value)]) (Attribute action))
 -> [Attribute action]
 -> Const (Endo [(MisoString, Value)]) [Attribute action])
-> (((MisoString, Value)
     -> Const (Endo [(MisoString, Value)]) (MisoString, Value))
    -> Attribute action
    -> Const (Endo [(MisoString, Value)]) (Attribute action))
-> Getting
     (Endo [(MisoString, Value)]) [Attribute action] (MisoString, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((MisoString, Value)
 -> Const (Endo [(MisoString, Value)]) (MisoString, Value))
-> Attribute action
-> Const (Endo [(MisoString, Value)]) (Attribute action)
forall action (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (MisoString, Value) (f (MisoString, Value))
-> p (Attribute action) (f (Attribute action))
_Property

findProp :: MisoString -> [Attribute action] -> Maybe JSON.Value
findProp :: forall action. MisoString -> [Attribute action] -> Maybe Value
findProp MisoString
k = MisoString -> [(MisoString, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup MisoString
k ([(MisoString, Value)] -> Maybe Value)
-> ([Attribute action] -> [(MisoString, Value)])
-> [Attribute action]
-> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Attribute action] -> [(MisoString, Value)]
forall action. [Attribute action] -> [(MisoString, Value)]
props

isTrueProp :: MisoString -> Attribute action -> Bool
isTrueProp :: forall action. MisoString -> Attribute action -> Bool
isTrueProp MisoString
k (Property ((MisoString
k MisoString -> MisoString -> Bool
forall a. Eq a => a -> a -> Bool
==) -> Bool
True) (JSON.Bool Bool
True)) = Bool
True
isTrueProp MisoString
k (Property ((MisoString
k MisoString -> MisoString -> Bool
forall a. Eq a => a -> a -> Bool
==) -> Bool
True) (JSON.String (MisoString -> MisoString
MisoString.toLower -> MisoString
"true"))) = Bool
True
isTrueProp MisoString
_ Attribute action
_ = Bool
False

hasTrueProp :: MisoString -> [Attribute action] -> Bool
hasTrueProp :: forall action. MisoString -> [Attribute action] -> Bool
hasTrueProp = (Attribute action -> Bool) -> [Attribute action] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Attribute action -> Bool) -> [Attribute action] -> Bool)
-> (MisoString -> Attribute action -> Bool)
-> MisoString
-> [Attribute action]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> Attribute action -> Bool
forall action. MisoString -> Attribute action -> Bool
isTrueProp

isAriaBusy :: Attribute action -> Bool
isAriaBusy :: forall action. Attribute action -> Bool
isAriaBusy = MisoString -> Attribute action -> Bool
forall action. MisoString -> Attribute action -> Bool
isTrueProp MisoString
"aria-busy"

hasAriaBusy :: [Attribute action] -> Bool
hasAriaBusy :: forall action. [Attribute action] -> Bool
hasAriaBusy = MisoString -> [Attribute action] -> Bool
forall action. MisoString -> [Attribute action] -> Bool
hasTrueProp MisoString
"aria-busy"

isRequired :: Attribute action -> Bool
isRequired :: forall action. Attribute action -> Bool
isRequired = MisoString -> Attribute action -> Bool
forall action. MisoString -> Attribute action -> Bool
isTrueProp MisoString
"required"

hasRequired :: [Attribute action] -> Bool
hasRequired :: forall action. [Attribute action] -> Bool
hasRequired = MisoString -> [Attribute action] -> Bool
forall action. MisoString -> [Attribute action] -> Bool
hasTrueProp MisoString
"required"

tryGetId :: [Attribute action] -> Maybe MisoString
tryGetId :: forall action. [Attribute action] -> Maybe MisoString
tryGetId =
    MisoString -> [Attribute action] -> Maybe Value
forall action. MisoString -> [Attribute action] -> Maybe Value
findProp MisoString
"id" ([Attribute action] -> Maybe Value)
-> (Value -> Maybe MisoString)
-> [Attribute action]
-> Maybe MisoString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
        JSON.String MisoString
s -> MisoString -> Maybe MisoString
forall a. a -> Maybe a
Just MisoString
s
        Value
_ -> Maybe MisoString
forall a. Maybe a
Nothing

ariaBusy_ :: Bool -> Attribute action
ariaBusy_ :: forall action. Bool -> Attribute action
ariaBusy_ =
    MisoString -> MisoString -> Attribute action
forall action. MisoString -> MisoString -> Attribute action
aria_ MisoString
"busy" (MisoString -> Attribute action)
-> (Bool -> MisoString) -> Bool -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. \case
        Bool
True -> MisoString
"true"
        Bool
False -> MisoString
"false"

ariaCurrent_ :: Bool -> Attribute action
ariaCurrent_ :: forall action. Bool -> Attribute action
ariaCurrent_ =
    MisoString -> MisoString -> Attribute action
forall action. MisoString -> MisoString -> Attribute action
aria_ MisoString
"current" (MisoString -> Attribute action)
-> (Bool -> MisoString) -> Bool -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. \case
        Bool
True -> MisoString
"true"
        Bool
False -> MisoString
"false"

ariaInvalid_ :: Bool -> Attribute action
ariaInvalid_ :: forall action. Bool -> Attribute action
ariaInvalid_ =
    MisoString -> MisoString -> Attribute action
forall action. MisoString -> MisoString -> Attribute action
aria_ MisoString
"invalid" (MisoString -> Attribute action)
-> (Bool -> MisoString) -> Bool -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. \case
        Bool
True -> MisoString
"true"
        Bool
False -> MisoString
"false"

ariaRole_ :: MisoString -> Attribute action
ariaRole_ :: forall action. MisoString -> Attribute action
ariaRole_ = MisoString -> MisoString -> Attribute action
forall action. MisoString -> MisoString -> Attribute action
aria_ MisoString
"role"

selectable_ :: Attribute action
selectable_ :: forall action. Attribute action
selectable_ = MisoString -> Attribute action
forall action. MisoString -> Attribute action
tabindex_ MisoString
"0"

unselectable_ :: Attribute action
unselectable_ :: forall action. Attribute action
unselectable_ = MisoString -> Attribute action
forall action. MisoString -> Attribute action
tabindex_ MisoString
"-1"

appearance_ :: Appearance -> Attribute action
appearance_ :: forall action. Appearance -> Attribute action
appearance_ = Appearance -> Attribute action
forall action. Appearance -> Attribute action
forall t action. Token t => t -> Attribute action
tokenAttr

autocomplete_ :: MisoString -> Attribute action
autocomplete_ :: forall action. MisoString -> Attribute action
autocomplete_ = MisoString -> MisoString -> Attribute action
forall action. MisoString -> MisoString -> Attribute action
textProp MisoString
"autocomplete"