{-# LANGUAGE DuplicateRecordFields #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

module Dashi.Components.ProgressBar where

import Clay hiding
    ( Background
    , Color
    , Value
    , action
    , fullWidth
    , max
    , size
    , value
    , var
    )
import Dashi.Prelude hiding (max, (&))
import Dashi.Style.Border (BorderColour (BorderFocusedColour))
import Dashi.Style.Colour
import Dashi.Style.Root (tokenDecl)
import Dashi.Style.Tokens
import Dashi.Style.Uchu (Uchu (..))
import Dashi.Style.Util
    ( backgroundColor'
    , borderRadiusAll'
    , fullWidth
    , var
    , (~:)
    )
import Data.List qualified as List
import Miso.Html.Element (progress_)
import Miso.Html.Property (max_, value_)

data Background = Background
    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, 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
Background = s
"progress-background-color"

instance ValueToken Background where
    type ValueType Background = LightDark Uchu
    tokenValue :: Background -> ValueType Background
tokenValue Background
Background = Uchu -> Uchu -> LightDark Uchu
forall c. c -> c -> LightDark c
LightDark Uchu
Yin1 Uchu
Yin9

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

instance Token Progress where
    tokenName :: forall s. (IsString s, Semigroup s) => Progress -> s
tokenName (Progress Appearance
appearance) =
        [Char] -> s
forall a. IsString a => [Char] -> a
fromString
            ([Char] -> s) -> ([Maybe [Char]] -> [Char]) -> [Maybe [Char]] -> s
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
. [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"-"
            ([[Char]] -> [Char])
-> ([Maybe [Char]] -> [[Char]]) -> [Maybe [Char]] -> [Char]
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 [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
catMaybes
            ([Maybe [Char]] -> s) -> [Maybe [Char]] -> s
forall a b. (a -> b) -> a -> b
$ [ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"progress"
              , [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"color"
              , Appearance -> Maybe [Char]
forall t s.
(Token t, Eq t, IsString s, Semigroup s) =>
t -> Maybe s
nonDefaultTokenName Appearance
appearance
              ]

instance ValueToken Progress where
    type ValueType Progress = LightDark Uchu
    tokenValue :: Progress -> ValueType Progress
tokenValue (Progress Appearance
Default) = BorderColour -> ValueType BorderColour
forall t. ValueToken t => t -> ValueType t
tokenValue BorderColour
BorderFocusedColour
    tokenValue (Progress Appearance
Subtle) = Uchu -> Uchu -> LightDark Uchu
forall c. c -> c -> LightDark c
LightDark Uchu
Yin9 Uchu
Yin2
    tokenValue (Progress Appearance
Primary) = Uchu -> LightDark Uchu
forall c. c -> LightDark c
sameLightDark Uchu
Blue
    tokenValue (Progress Appearance
Success) = Uchu -> LightDark Uchu
forall c. c -> LightDark c
sameLightDark Uchu
Green6
    tokenValue (Progress Appearance
Warning) = Uchu -> LightDark Uchu
forall c. c -> LightDark c
sameLightDark Uchu
Orange
    tokenValue (Progress Appearance
Danger) = Uchu -> LightDark Uchu
forall c. c -> LightDark c
sameLightDark Uchu
Red
    tokenValue (Progress Appearance
Discovery) = Uchu -> LightDark Uchu
forall c. c -> LightDark c
sameLightDark Uchu
Purple

data Value
    = Determinate {Value -> Int
value :: Int, Value -> Int
max :: Int}
    | Indeterminate

data ProgressBar = ProgressBar
    { ProgressBar -> Value
value :: Value
    , ProgressBar -> Appearance
appearance :: Appearance
    , ProgressBar -> SizeToken
size :: SizeToken
    }

instance Widget ProgressBar model action where
    widget' :: [Attribute action] -> ProgressBar -> View model action
widget' [Attribute action]
attrs ProgressBar{Appearance
SizeToken
Value
value :: ProgressBar -> Value
appearance :: ProgressBar -> Appearance
size :: ProgressBar -> SizeToken
value :: Value
appearance :: Appearance
size :: SizeToken
..} =
        [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
progress_ (SizeToken -> Attribute action
forall action. SizeToken -> Attribute action
forall t action. Token t => t -> Attribute action
tokenAttr SizeToken
size Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
valueAttrs [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. Semigroup a => a -> a -> a
<> [Attribute action]
attrs) []
      where
        valueAttrs :: [Attribute action]
valueAttrs =
            case Value
value of
                Determinate{Int
value :: Value -> Int
max :: Value -> Int
value :: Int
max :: Int
..} -> [MisoString -> Attribute action
forall action. MisoString -> Attribute action
value_ (MisoString -> Attribute action) -> MisoString -> Attribute action
forall a b. (a -> b) -> a -> b
$ Int -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString Int
value, MisoString -> Attribute action
forall action. MisoString -> Attribute action
max_ (MisoString -> Attribute action) -> MisoString -> Attribute action
forall a b. (a -> b) -> a -> b
$ Int -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString Int
max]
                Value
Indeterminate -> [MisoString -> MisoString -> Attribute action
forall action. MisoString -> MisoString -> Attribute action
textProp MisoString
"indeterminate" MisoString
""]
    style :: Css
style = do
        Selector
":root" Selector -> Css -> Css
? do
            forall t. (ValueToken t, Val (ValueType t)) => Css
tokenDecl @Background
            forall t. (ValueToken t, Val (ValueType t)) => Css
tokenDecl @Progress
        Selector
progress Selector -> Css -> Css
? do
            Display -> Css
display Display
block
            Css
fullWidth
            Background -> Css
forall t. Token t => t -> Css
backgroundColor' Background
Background
            (SizeToken -> Css) -> Css
forall t. Token t => (t -> Css) -> Css
byTokens ((SizeToken -> Css) -> Css) -> (SizeToken -> Css) -> Css
forall a b. (a -> b) -> a -> b
$ Size LengthUnit -> Css
forall a. Size a -> Css
height (Size LengthUnit -> Css)
-> (SizeToken -> Size LengthUnit) -> SizeToken -> 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
. Space -> Size LengthUnit
Space -> ValueType Space
forall t. ValueToken t => t -> ValueType t
tokenValue (Space -> Size LengthUnit)
-> (SizeToken -> Space) -> SizeToken -> Size LengthUnit
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
. SizeToken -> Space
Space
            SizeToken -> Css
borderRadiusAll' SizeToken
Large
            Refinement
"::-webkit-progress-bar" Refinement -> Css -> Css
& do
                SizeToken -> Css
borderRadiusAll' SizeToken
Large
                Color -> Css
forall a. Background a => a -> Css
background Color
transparent
            Refinement
"::-webkit-progress-value" Refinement -> Css -> Css
& do
                SizeToken -> Css
borderRadiusAll' SizeToken
Large
                Progress -> Css
forall t. Token t => t -> Css
backgroundColor' (Progress -> Css) -> Progress -> Css
forall a b. (a -> b) -> a -> b
$ Appearance -> Progress
Progress Appearance
Default
            Refinement
"::-moz-progress-bar" Refinement -> Css -> Css
& do
                SizeToken -> Css
borderRadiusAll' SizeToken
Large
                Progress -> Css
forall t. Token t => t -> Css
backgroundColor' (Progress -> Css) -> Progress -> Css
forall a b. (a -> b) -> a -> b
$ Appearance -> Progress
Progress Appearance
Default
            Refinement
indeterminate Refinement -> Css -> Css
& do
                Refinement
"::-webkit-progress-value" Refinement -> Css -> Css
& Color -> Css
forall a. Background a => a -> Css
background Color
transparent
                Refinement
"::-moz-progress-bar" Refinement -> Css -> Css
& Color -> Css
forall a. Background a => a -> Css
background Color
transparent
                Key MisoString
"background"
                    Key MisoString -> Value -> Css
~: [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat
                        [ MisoString -> [Value] -> Value
forall v. (Val v, Other v) => MisoString -> [v] -> v
var (Background -> MisoString
forall s. (IsString s, Semigroup s) => Background -> s
forall t s. (Token t, IsString s, Semigroup s) => t -> s
tokenName Background
Background) []
                        , Value
" "
                        , [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat
                            [ Value
"linear-gradient(to right, "
                            , MisoString -> [Value] -> Value
forall v. (Val v, Other v) => MisoString -> [v] -> v
var (Progress -> MisoString
forall s. (IsString s, Semigroup s) => Progress -> s
forall t s. (Token t, IsString s, Semigroup s) => t -> s
tokenName (Progress -> MisoString) -> Progress -> MisoString
forall a b. (a -> b) -> a -> b
$ Appearance -> Progress
Progress Appearance
Default) []
                            , Value
" 30%, transparent 30%)"
                            ]
                        , Value
" "
                        , Value
"top left / 150% 150% no-repeat"
                        ]
                AnimationName
-> Time
-> TimingFunction
-> Time
-> IterationCount
-> AnimationDirection
-> FillMode
-> Css
animation
                    AnimationName
"progress-indeterminate"
                    (Double -> Time
sec Double
2)
                    TimingFunction
easeInOut
                    (Double -> Time
sec Double
0)
                    IterationCount
infinite
                    AnimationDirection
forall a. Normal a => a
normal
                    FillMode
forwards

        MisoString -> [(Number, Css)] -> Css
keyframes
            MisoString
"progress-indeterminate"
            [ (Number
0, BackgroundPosition -> Css
backgroundPosition (BackgroundPosition -> Css) -> BackgroundPosition -> Css
forall a b. (a -> b) -> a -> b
$ Size Percentage -> Size Percentage -> BackgroundPosition
forall a. Size a -> Size a -> BackgroundPosition
positioned (Number -> Size Percentage
pct Number
200) Size Percentage
forall a. Size a
nil)
            , (Number
100, BackgroundPosition -> Css
backgroundPosition (BackgroundPosition -> Css) -> BackgroundPosition -> Css
forall a b. (a -> b) -> a -> b
$ Size Percentage -> Size Percentage -> BackgroundPosition
forall a. Size a -> Size a -> BackgroundPosition
positioned (Number -> Size Percentage
pct (Number -> Size Percentage)
-> (Number -> Number) -> Number -> Size Percentage
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
. Number -> Number
forall a. Num a => a -> a
negate (Number -> Size Percentage) -> Number -> Size Percentage
forall a b. (a -> b) -> a -> b
$ Number
200) Size Percentage
forall a. Size a
nil)
            ]