{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-}
{-# OPTIONS_GHC -Wno-missing-role-annotations #-}
{-# OPTIONS_GHC -Wno-term-variable-capture #-}

module Dashi.Components.TextField where

import Clay hiding
    ( Background
    , Color
    , Number
    , fullWidth
    , name
    , not
    , type_
    , valid
    , value
    , var
    )
import Clay qualified
import Dashi.Components.Util (ariaInvalid_)
import Dashi.Prelude hiding ((#), (&))
import Dashi.Style.Border (BorderColour (..))
import Dashi.Style.Colour (LightDark (..))
import Dashi.Style.Pseudo (focusable)
import Dashi.Style.Root (tokenDecl)
import Dashi.Style.Tokens
import Dashi.Style.Uchu (Uchu (..), UchuAlpha (..))
import Dashi.Style.Util
import Miso.Html.Element (input_, textarea_)
import Miso.Html.Event qualified as Html
import Miso.Html.Property (name_, type_, value_)

newtype Border = Border InputState
    deriving newtype (Border -> Border -> Bool
(Border -> Border -> Bool)
-> (Border -> Border -> Bool) -> Eq Border
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Border -> Border -> Bool
== :: Border -> Border -> Bool
$c/= :: Border -> Border -> Bool
/= :: Border -> Border -> Bool
Eq, Border
Border -> Border -> Bounded Border
forall a. a -> a -> Bounded a
$cminBound :: Border
minBound :: Border
$cmaxBound :: Border
maxBound :: Border
Bounded, Int -> Border
Border -> Int
Border -> [Border]
Border -> Border
Border -> Border -> [Border]
Border -> Border -> Border -> [Border]
(Border -> Border)
-> (Border -> Border)
-> (Int -> Border)
-> (Border -> Int)
-> (Border -> [Border])
-> (Border -> Border -> [Border])
-> (Border -> Border -> [Border])
-> (Border -> Border -> Border -> [Border])
-> Enum Border
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Border -> Border
succ :: Border -> Border
$cpred :: Border -> Border
pred :: Border -> Border
$ctoEnum :: Int -> Border
toEnum :: Int -> Border
$cfromEnum :: Border -> Int
fromEnum :: Border -> Int
$cenumFrom :: Border -> [Border]
enumFrom :: Border -> [Border]
$cenumFromThen :: Border -> Border -> [Border]
enumFromThen :: Border -> Border -> [Border]
$cenumFromTo :: Border -> Border -> [Border]
enumFromTo :: Border -> Border -> [Border]
$cenumFromThenTo :: Border -> Border -> Border -> [Border]
enumFromThenTo :: Border -> Border -> Border -> [Border]
Enum)

newtype Background = Background InputState
    deriving newtype (Background -> Background -> Bool
(Background -> Background -> Bool)
-> (Background -> Background -> Bool) -> Eq Background
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Background -> Background -> Bool
== :: Background -> Background -> Bool
$c/= :: Background -> Background -> Bool
/= :: Background -> Background -> Bool
Eq, Background
Background -> Background -> Bounded Background
forall a. a -> a -> Bounded a
$cminBound :: Background
minBound :: Background
$cmaxBound :: Background
maxBound :: Background
Bounded, Int -> Background
Background -> Int
Background -> [Background]
Background -> Background
Background -> Background -> [Background]
Background -> Background -> Background -> [Background]
(Background -> Background)
-> (Background -> Background)
-> (Int -> Background)
-> (Background -> Int)
-> (Background -> [Background])
-> (Background -> Background -> [Background])
-> (Background -> Background -> [Background])
-> (Background -> Background -> Background -> [Background])
-> Enum Background
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Background -> Background
succ :: Background -> Background
$cpred :: Background -> Background
pred :: Background -> Background
$ctoEnum :: Int -> Background
toEnum :: Int -> Background
$cfromEnum :: Background -> Int
fromEnum :: Background -> Int
$cenumFrom :: Background -> [Background]
enumFrom :: Background -> [Background]
$cenumFromThen :: Background -> Background -> [Background]
enumFromThen :: Background -> Background -> [Background]
$cenumFromTo :: Background -> Background -> [Background]
enumFromTo :: Background -> Background -> [Background]
$cenumFromThenTo :: Background -> Background -> Background -> [Background]
enumFromThenTo :: Background -> Background -> Background -> [Background]
Enum)

instance Token Background where
    tokenName :: forall s. (IsString s, Semigroup s) => Background -> s
tokenName (Background InputState
state) = s
"input-background-" s -> s -> s
forall a. Semigroup a => a -> a -> a
<> InputState -> s
forall s. (IsString s, Semigroup s) => InputState -> s
forall t s. (Token t, IsString s, Semigroup s) => t -> s
tokenName InputState
state
    tokenAttr :: forall action. Background -> Attribute action
tokenAttr (Background InputState
state) = InputState -> Attribute action
forall action. InputState -> Attribute action
forall t action. Token t => t -> Attribute action
tokenAttr InputState
state

instance ValueToken Background where
    type ValueType Background = LightDark (UchuAlpha Milli)
    tokenValue :: Background -> ValueType Background
tokenValue (Background InputState
state) = (Uchu -> Milli -> UchuAlpha Milli)
-> Milli -> Uchu -> UchuAlpha Milli
forall a b c. (a -> b -> c) -> b -> a -> c
flip Uchu -> Milli -> UchuAlpha Milli
forall a. Uchu -> a -> UchuAlpha a
UchuAlpha Milli
alpha (Uchu -> UchuAlpha Milli)
-> LightDark Uchu -> LightDark (UchuAlpha Milli)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uchu -> Uchu -> LightDark Uchu
forall c. c -> c -> LightDark c
LightDark Uchu
Yin Uchu
Yang
      where
        alpha :: Milli
alpha
            | InputState
state InputState -> InputState -> Bool
forall a. Eq a => a -> a -> Bool
== InputState
HoveredState = Milli
0.05
            | Bool
otherwise = Milli
0

data Type
    = Text
    | Password
    | Number
    | Email
    | MultiLine
    deriving stock (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
/= :: Type -> Type -> Bool
Eq, Type
Type -> Type -> Bounded Type
forall a. a -> a -> Bounded a
$cminBound :: Type
minBound :: Type
$cmaxBound :: Type
maxBound :: Type
Bounded, Int -> Type
Type -> Int
Type -> [Type]
Type -> Type
Type -> Type -> [Type]
Type -> Type -> Type -> [Type]
(Type -> Type)
-> (Type -> Type)
-> (Int -> Type)
-> (Type -> Int)
-> (Type -> [Type])
-> (Type -> Type -> [Type])
-> (Type -> Type -> [Type])
-> (Type -> Type -> Type -> [Type])
-> Enum Type
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Type -> Type
succ :: Type -> Type
$cpred :: Type -> Type
pred :: Type -> Type
$ctoEnum :: Int -> Type
toEnum :: Int -> Type
$cfromEnum :: Type -> Int
fromEnum :: Type -> Int
$cenumFrom :: Type -> [Type]
enumFrom :: Type -> [Type]
$cenumFromThen :: Type -> Type -> [Type]
enumFromThen :: Type -> Type -> [Type]
$cenumFromTo :: Type -> Type -> [Type]
enumFromTo :: Type -> Type -> [Type]
$cenumFromThenTo :: Type -> Type -> Type -> [Type]
enumFromThenTo :: Type -> Type -> Type -> [Type]
Enum)

instance Token Type where
    tokenName :: forall s. (IsString s, Semigroup s) => Type -> s
tokenName Type
Text = s
"text"
    tokenName Type
Password = s
"password"
    tokenName Type
Number = s
"number"
    tokenName Type
Email = s
"email"
    tokenName Type
MultiLine = s
"multiline"
    tokenAttr :: forall action. Type -> Attribute action
tokenAttr = MisoString -> Attribute action
forall action. MisoString -> Attribute action
type_ (MisoString -> Attribute action)
-> (Type -> MisoString) -> Type -> 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
. Type -> MisoString
forall s. (IsString s, Semigroup s) => Type -> s
forall t s. (Token t, IsString s, Semigroup s) => t -> s
tokenName
    byToken :: Type -> Refinement
byToken = (MisoString
"type" MisoString -> MisoString -> Refinement
@=) (MisoString -> Refinement)
-> (Type -> MisoString) -> Type -> Refinement
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
. Type -> MisoString
forall s. (IsString s, Semigroup s) => Type -> s
forall t s. (Token t, IsString s, Semigroup s) => t -> s
tokenName

data TextField action = TextField
    { forall action. TextField action -> MisoString
name :: MisoString
    , forall action. TextField action -> Type
type' :: Type
    , forall action. TextField action -> Maybe MisoString
value :: Maybe MisoString
    , forall action. TextField action -> Bool
valid :: Bool
    , forall action. TextField action -> MisoString -> action
onChange :: MisoString -> action
    }

instance Widget (TextField action) model action where
    widget' :: [Attribute action] -> TextField action -> View model action
widget' [Attribute action]
attrs TextField{Bool
Maybe MisoString
MisoString
Type
MisoString -> action
name :: forall action. TextField action -> MisoString
type' :: forall action. TextField action -> Type
value :: forall action. TextField action -> Maybe MisoString
valid :: forall action. TextField action -> Bool
onChange :: forall action. TextField action -> MisoString -> action
name :: MisoString
type' :: Type
value :: Maybe MisoString
valid :: Bool
onChange :: MisoString -> action
..}
        | Type
type' Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
MultiLine = [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
textarea_ [Attribute action]
attrs' ([View model action] -> View model action)
-> (Maybe MisoString -> [View model action])
-> Maybe MisoString
-> View model 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
. (MisoString -> View model action)
-> [MisoString] -> [View model action]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MisoString -> View model action
forall model action. MisoString -> View model action
text ([MisoString] -> [View model action])
-> (Maybe MisoString -> [MisoString])
-> Maybe MisoString
-> [View model 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
. Maybe MisoString -> [MisoString]
forall a. Maybe a -> [a]
maybeToList (Maybe MisoString -> View model action)
-> Maybe MisoString -> View model action
forall a b. (a -> b) -> a -> b
$ Maybe MisoString
value
        | Bool
otherwise =
            [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
input_ (Type -> Attribute action
forall t action. Token t => t -> Attribute action
forall action. Type -> Attribute action
tokenAttr Type
type' Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs' [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. Semigroup a => a -> a -> a
<> (MisoString -> Attribute action
forall action. MisoString -> Attribute action
value_ (MisoString -> Attribute action)
-> [MisoString] -> [Attribute action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MisoString -> [MisoString]
forall a. Maybe a -> [a]
maybeToList Maybe MisoString
value))
      where
        attrs' :: [Attribute action]
attrs' = MisoString -> Attribute action
forall action. MisoString -> Attribute action
name_ MisoString
name Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: (MisoString -> action) -> Attribute action
forall action. (MisoString -> action) -> Attribute action
Html.onInput MisoString -> action
onChange Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. Semigroup a => a -> a -> a
<> [Bool -> Attribute action
forall action. Bool -> Attribute action
ariaInvalid_ Bool
True | Bool -> Bool
not Bool
valid]
    style :: Css
style = do
        Selector
":root" Selector -> Css -> Css
? forall t. (ValueToken t, Val (ValueType t)) => Css
tokenDecl @Background
        (Selector
Clay.select Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> Selector
textarea Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> Selector
input Selector -> Refinement -> Selector
# forall t. Token t => Refinement
isOneOfAll' @Type) Selector -> Css -> Css
? do
            Display -> Css
display Display
block
            Css
fullWidth
            Css
focusable
            Size LengthUnit -> Stroke -> Color -> Css
border (BorderWidth -> ValueType BorderWidth
forall t.
(Token t, Val (ValueType t), Other (ValueType t)) =>
t -> ValueType t
token BorderWidth
BorderWidth) Stroke
solid (BorderColour -> Color
forall t. Token t => t -> Color
colorToken BorderColour
BorderColour)
            Appearance -> Refinement
forall t. Token t => t -> Refinement
byToken Appearance
Subtle Refinement -> Css -> Css
& do
                Color -> Css
borderColor Color
transparent
            SizeToken -> Css
paddingAll' SizeToken
XSmall
            SizeToken -> Css
borderRadiusAll' SizeToken
Small
            MisoString -> Time -> TimingFunction -> Time -> Css
transition MisoString
"background" (Double -> Time
sec Double
0.2) TimingFunction
easeOut Time
0
            Background -> Css
forall t. Token t => t -> Css
backgroundColor' (Background -> Css) -> Background -> Css
forall a b. (a -> b) -> a -> b
$ InputState -> Background
Background InputState
DefaultState
            Refinement
hover Refinement -> Refinement -> Refinement
forall a. Semigroup a => a -> a -> a
<> Refinement -> Refinement
forall a. Not a => a -> Refinement
Clay.not Refinement
focusVisible Refinement -> Css -> Css
& do
                BorderColour -> Css
forall t. Token t => t -> Css
borderColor' BorderColour
BorderColour
                Background -> Css
forall t. Token t => t -> Css
backgroundColor' (Background -> Css) -> Background -> Css
forall a b. (a -> b) -> a -> b
$ InputState -> Background
Background InputState
HoveredState
            Refinement
focusVisible Refinement -> Css -> Css
& do
                BorderColour -> Css
forall t. Token t => t -> Css
borderColor' BorderColour
BorderFocusedColour
                Background -> Css
forall t. Token t => t -> Css
backgroundColor' (Background -> Css) -> Background -> Css
forall a b. (a -> b) -> a -> b
$ InputState -> Background
Background InputState
ActiveState
            [Refinement] -> Refinement
isOneOf [Refinement
":user-invalid", MisoString
"aria-invalid" MisoString -> MisoString -> Refinement
@= MisoString
"true"]
                Refinement -> Css -> Css
& Refinement
":not(:focus-visible)"
                Refinement -> Css -> Css
& BorderColour -> Css
forall t. Token t => t -> Css
borderColor' BorderColour
BorderDangerColour
        Selector
textarea Selector -> Css -> Css
? do
            Key MisoString
"resize" Key MisoString -> MisoString -> Css
-: MisoString
"vertical"
            Size LengthUnit -> Css
forall a. Size a -> Css
minHeight (Size LengthUnit -> Css) -> Size LengthUnit -> Css
forall a b. (a -> b) -> a -> b
$ Number -> Size LengthUnit
em Number
10