{-# LANGUAGE OverloadedLists #-}
{-# OPTIONS_GHC -Wno-missing-role-annotations #-}
{-# OPTIONS_GHC -Wno-term-variable-capture #-}

module Dashi.Components.Switch where

import Clay hiding (Background, checked, label, name, selected, span_, type_)
import Clay qualified hiding (Background)
import Dashi.Components.Util (ariaRole_)
import Dashi.Prelude hiding ((#), (&))
import Dashi.Style.Border (BorderColour (BorderColour, BorderFocusedColour))
import Dashi.Style.Colour (LightDark)
import Dashi.Style.Root (tokenDecl)
import Dashi.Style.Tokens
import Dashi.Style.Uchu (Uchu (Yang))
import Dashi.Style.Util
import Data.Coerce (coerce)
import Data.Vector.Strict qualified as Vector
import Miso.Html.Element (input_, label_, span_)
import Miso.Html.Event (onChecked)
import Miso.Html.Property (checked_, name_, type_)

data Foreground = Foreground
    deriving stock (Foreground -> Foreground -> Bool
(Foreground -> Foreground -> Bool)
-> (Foreground -> Foreground -> Bool) -> Eq Foreground
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Foreground -> Foreground -> Bool
== :: Foreground -> Foreground -> Bool
$c/= :: Foreground -> Foreground -> Bool
/= :: Foreground -> Foreground -> Bool
Eq, Foreground
Foreground -> Foreground -> Bounded Foreground
forall a. a -> a -> Bounded a
$cminBound :: Foreground
minBound :: Foreground
$cmaxBound :: Foreground
maxBound :: Foreground
Bounded, Int -> Foreground
Foreground -> Int
Foreground -> [Foreground]
Foreground -> Foreground
Foreground -> Foreground -> [Foreground]
Foreground -> Foreground -> Foreground -> [Foreground]
(Foreground -> Foreground)
-> (Foreground -> Foreground)
-> (Int -> Foreground)
-> (Foreground -> Int)
-> (Foreground -> [Foreground])
-> (Foreground -> Foreground -> [Foreground])
-> (Foreground -> Foreground -> [Foreground])
-> (Foreground -> Foreground -> Foreground -> [Foreground])
-> Enum Foreground
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 :: Foreground -> Foreground
succ :: Foreground -> Foreground
$cpred :: Foreground -> Foreground
pred :: Foreground -> Foreground
$ctoEnum :: Int -> Foreground
toEnum :: Int -> Foreground
$cfromEnum :: Foreground -> Int
fromEnum :: Foreground -> Int
$cenumFrom :: Foreground -> [Foreground]
enumFrom :: Foreground -> [Foreground]
$cenumFromThen :: Foreground -> Foreground -> [Foreground]
enumFromThen :: Foreground -> Foreground -> [Foreground]
$cenumFromTo :: Foreground -> Foreground -> [Foreground]
enumFromTo :: Foreground -> Foreground -> [Foreground]
$cenumFromThenTo :: Foreground -> Foreground -> Foreground -> [Foreground]
enumFromThenTo :: Foreground -> Foreground -> Foreground -> [Foreground]
Enum)

instance Token Foreground where
    tokenName :: forall s. (IsString s, Semigroup s) => Foreground -> s
tokenName Foreground
Foreground = s
"switch-foreground"

instance ValueToken Foreground where
    type ValueType Foreground = Uchu
    tokenValue :: Foreground -> ValueType Foreground
tokenValue Foreground
Foreground = ValueType Foreground
Uchu
Yang

newtype Background = Background Bool
    deriving stock (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)

allBackgrounds :: Vector Background
allBackgrounds :: Vector Background
allBackgrounds = Bool -> Background
Background (Bool -> Background) -> Vector Bool -> Vector Background
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bool
Item (Vector Bool)
forall a. Bounded a => a
minBound .. Bool
Item (Vector Bool)
forall a. Bounded a => a
maxBound]

instance Enum Background where
    toEnum :: Int -> Background
toEnum = Vector Background -> Int -> Background
forall a. Vector a -> Int -> a
(Vector.!) Vector Background
allBackgrounds
    fromEnum :: Background -> Int
fromEnum = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int)
-> (Background -> Maybe Int) -> Background -> Int
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
. ((Background -> Bool) -> Vector Background -> Maybe Int)
-> Vector Background -> (Background -> Bool) -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Background -> Bool) -> Vector Background -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
Vector.findIndex Vector Background
allBackgrounds ((Background -> Bool) -> Maybe Int)
-> (Background -> Background -> Bool) -> Background -> Maybe Int
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
. Background -> Background -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance Token Background where
    tokenName :: forall s. (IsString s, Semigroup s) => Background -> s
tokenName (Background Bool
checked) = s
"switch-background" s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s -> s -> Bool -> s
forall a. a -> a -> Bool -> a
bool s
"" s
"-checked" Bool
checked

instance ValueToken Background where
    type ValueType Background = LightDark Uchu
    tokenValue :: Background -> ValueType Background
tokenValue (Background Bool
False) = BorderColour -> ValueType BorderColour
forall t. ValueToken t => t -> ValueType t
tokenValue BorderColour
BorderColour
    tokenValue (Background Bool
True) = BorderColour -> ValueType BorderColour
forall t. ValueToken t => t -> ValueType t
tokenValue BorderColour
BorderFocusedColour

data Switch model action = Switch
    { forall model action. Switch model action -> MisoString
name :: MisoString
    , forall model action. Switch model action -> [View model action]
label :: [View model action]
    , forall model action. Switch model action -> Bool
checked :: Bool
    , forall model action. Switch model action -> Bool -> action
onChange :: Bool -> action
    }

instance Widget (Switch model action) model action where
    widget' :: [Attribute action] -> Switch model action -> View model action
widget' [Attribute action]
attrs Switch{Bool
[View model action]
MisoString
Bool -> action
name :: forall model action. Switch model action -> MisoString
label :: forall model action. Switch model action -> [View model action]
checked :: forall model action. Switch model action -> Bool
onChange :: forall model action. Switch model action -> Bool -> action
name :: MisoString
label :: [View model action]
checked :: Bool
onChange :: Bool -> action
..}
        | [View model action] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [View model action]
label = View model action
inputEl
        | Bool
otherwise = [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
label_ [] [Item [View model action]
View model action
inputEl, [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
span_ [] [View model action]
label]
      where
        inputEl :: View model action
inputEl =
            [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
input_
                ([Attribute action] -> View model action)
-> [Attribute action] -> View model action
forall a b. (a -> b) -> a -> b
$ MisoString -> Attribute action
forall action. MisoString -> Attribute action
type_ MisoString
"checkbox"
                Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
ariaRole_ MisoString
"switch"
                Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
name_ MisoString
name
                Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: Bool -> Attribute action
forall action. Bool -> Attribute action
checked_ Bool
checked
                Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: (Checked -> action) -> Attribute action
forall action. (Checked -> action) -> Attribute action
onChecked (Bool -> action
onChange (Bool -> action) -> (Checked -> Bool) -> Checked -> 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
. forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @Checked)
                Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs
    style :: Css
style = do
        Selector
":root" Selector -> Css -> Css
? do
            forall t. (ValueToken t, Val (ValueType t)) => Css
tokenDecl @Foreground
            forall t. (ValueToken t, Val (ValueType t)) => Css
tokenDecl @Background
        Selector
input Selector -> Refinement -> Selector
# MisoString -> Refinement
ariaRole MisoString
"switch" Selector -> Css -> Css
? do
            SizeToken -> Css
fontSize' SizeToken
Large
            Display -> Css
display Display
flex
            FlexDirection -> Css
flexDirection FlexDirection
row
            AlignItemsValue -> Css
alignItems AlignItemsValue
forall a. Center a => a
center
            let heightEm :: Number
heightEm = Number
0.9 :: Number
                widthEm :: Number
widthEm = Number
1.6 :: Number
                knobSize :: Number
knobSize = Number
heightEm
            Size LengthUnit -> Css
forall a. Size a -> Css
width (Size LengthUnit -> Css) -> Size LengthUnit -> Css
forall a b. (a -> b) -> a -> b
$ Number -> Size LengthUnit
em Number
widthEm
            Size LengthUnit -> Css
forall a. Size a -> Css
height (Size LengthUnit -> Css) -> Size LengthUnit -> Css
forall a b. (a -> b) -> a -> b
$ Number -> Size LengthUnit
em Number
heightEm
            Background -> Css
forall t. Token t => t -> Css
backgroundColor' (Background -> Css) -> Background -> Css
forall a b. (a -> b) -> a -> b
$ Bool -> Background
Background Bool
False
            Size LengthUnit -> Stroke -> Color -> Css
border (Number -> Size LengthUnit
em Number
0.1) Stroke
solid Color
transparent
            SizeToken -> Css
borderRadiusAll' SizeToken
XLarge
            MisoString -> Time -> TimingFunction -> Time -> Css
transition MisoString
"all" (Double -> Time
sec Double
0.15) TimingFunction
easeInOut Time
0
            Refinement
before Refinement -> Css -> Css
& do
                Css -> Css
important (Css -> Css) -> (MisoString -> Css) -> MisoString -> Css
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
. Content -> Css
content (Content -> Css) -> (MisoString -> Content) -> MisoString -> Css
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 -> Content
stringContent (MisoString -> Css) -> MisoString -> Css
forall a b. (a -> b) -> a -> b
$ MisoString
""
                Css -> Css
important (Css -> Css) -> Css -> Css
forall a b. (a -> b) -> a -> b
$ Key MisoString
"font-size" Key MisoString -> MisoString -> Css
-: MisoString
"inherit"
                Size (ZonkAny 0) -> Css
forall a. Size a -> Css
top (Size (ZonkAny 0) -> Css) -> Size (ZonkAny 0) -> Css
forall a b. (a -> b) -> a -> b
$ Number -> Size (ZonkAny 0)
forall a. Number -> Size a
unitless Number
0
                Foreground -> Css
forall t. Token t => t -> Css
backgroundColor' Foreground
Foreground
                Display -> Css
display Display
block
                AspectRatio -> Css
aspectRatio AspectRatio
1
                Size Percentage -> Css
forall a. Size a -> Css
height (Size Percentage -> Css) -> Size Percentage -> Css
forall a b. (a -> b) -> a -> b
$ Number -> Size Percentage
pct Number
100
                SizeToken -> Css
borderRadiusAll' SizeToken
XLarge
                MisoString -> Time -> TimingFunction -> Time -> Css
transition MisoString
"margin" (Double -> Time
sec Double
0.075) TimingFunction
easeInOut Time
0
            Refinement
Clay.checked Refinement -> Css -> Css
& do
                Background -> Css
forall t. Token t => t -> Css
backgroundColor' (Background -> Css) -> Background -> Css
forall a b. (a -> b) -> a -> b
$ Bool -> Background
Background Bool
True
                Refinement
before Refinement -> Css -> Css
& do
                    Key MisoString
"margin-inline-start" Key MisoString -> Size LengthUnit -> Css
forall v. Val v => Key MisoString -> v -> Css
~:: Number -> Size LengthUnit
em (Number
widthEm Number -> Number -> Number
forall a. Num a => a -> a -> a
- Number
knobSize)