{-# LANGUAGE OverloadedLists #-}
{-# OPTIONS_GHC -Wno-term-variable-capture #-}

module Dashi.Components.Message where

import Clay hiding (Background, i, icon, size, span_, title)
import Dashi.Components.Icon
    ( Icon (..)
    , Phosphor (CheckCircle, Info, Question, WarningDiamond)
    , Weight (..)
    )
import Dashi.Components.Icon qualified as Icon
import Dashi.Components.Util (selectable_)
import Dashi.Prelude hiding (has, none, (#), (&))
import Dashi.Style.Background (BackgroundColour (BackgroundColour))
import Dashi.Style.Pseudo (pressable)
import Dashi.Style.Text (TextColour (TextColour))
import Dashi.Style.Tokens
import Dashi.Style.Util
import Miso.Html.Element (a_, div_, span_)
import Miso.Html.Property (class_)

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

instance Token MessageSize where
    tokenName :: forall s. (IsString s, Semigroup s) => MessageSize -> s
tokenName MessageSize
InlineMessage = s
"inline"
    tokenName MessageSize
FormMessage = s
"form"
    tokenName MessageSize
SectionMessage = s
"section"

data MessageIcon
    = DefaultIcon
    | CustomIcon Icon

data Message = Message
    { Message -> MessageSize
size :: MessageSize
    , Message -> Appearance
appearance :: Appearance
    , Message -> Maybe MessageIcon
icon :: Maybe MessageIcon
    , Message -> Maybe Text
title :: Maybe MisoString
    , Message -> Maybe Text
secondary :: Maybe MisoString
    }

sizeStyle :: MessageSize -> Css
sizeStyle :: MessageSize -> Css
sizeStyle MessageSize
InlineMessage = do
    Css
pressable
    Css
underlinedOnHover
    Display -> Css
display Display
inlineFlex
    FlexDirection -> Css
flexDirection FlexDirection
row
    AlignItemsValue -> Css
alignItems AlignItemsValue
forall a. Center a => a
center
    Selector
".title" Selector -> Css -> Css
? TextColour -> Css
forall t. Token t => t -> Css
color' (Appearance -> TextColour
TextColour Appearance
Default)
    Selector
".secondary" Selector -> Css -> Css
? TextColour -> Css
forall t. Token t => t -> Css
color' (Appearance -> TextColour
TextColour Appearance
Subtle)
    FontWeight -> Css
fontWeight (FontWeight -> Css) -> FontWeight -> Css
forall a b. (a -> b) -> a -> b
$ Integer -> FontWeight
weight Integer
500
    SizeToken -> Css
gap' SizeToken
XSmall
    Selector
".icon" Selector -> Css -> Css
? do
        Position -> Css
position Position
relative
        Size LengthUnit -> Css
forall a. Size a -> Css
top (Size LengthUnit -> Css)
-> (Number -> Size LengthUnit) -> Number -> 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
. Number -> Size LengthUnit
em (Number -> Css) -> Number -> Css
forall a b. (a -> b) -> a -> b
$ -Number
0.025
sizeStyle MessageSize
FormMessage = do
    Display -> Css
display Display
flex
    FlexDirection -> Css
flexDirection FlexDirection
row
    AlignItemsValue -> Css
alignItems AlignItemsValue
forall a. Center a => a
center
    SizeToken -> Css
gap' SizeToken
XSmall
    Selector
".icon" Selector -> Css -> Css
? do
        SizeToken -> Css
fontSize' SizeToken
Large
        Position -> Css
position Position
relative
        Size LengthUnit -> Css
forall a. Size a -> Css
top (Size LengthUnit -> Css)
-> (Number -> Size LengthUnit) -> Number -> 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
. Number -> Size LengthUnit
em (Number -> Css) -> Number -> Css
forall a b. (a -> b) -> a -> b
$ -Number
0.01
    SizeToken -> Css
fontSize' SizeToken
Small
sizeStyle MessageSize
SectionMessage = do
    SizeToken -> Css
borderRadiusAll' SizeToken
Medium
    SizeToken -> Css
paddingAll' SizeToken
Medium
    Size LengthUnit -> Css
forall a. Size a -> Css
paddingRight (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) -> SizeToken -> Css
forall a b. (a -> b) -> a -> b
$ SizeToken
Large
    Display -> Css
display Display
flex
    AlignItemsValue -> Css
alignItems AlignItemsValue
forall a. Center a => a
center
    NonEmpty Refinement -> Refinement
forall a. Semigroup a => NonEmpty a -> a
sconcat [Selector -> Refinement
has Selector
".title", Selector -> Refinement
has Selector
".secondary"] Refinement -> Css -> Css
& do
        Display -> Css
display Display
grid
        [[Value]] -> Css
gridTemplateAreas
            [ [Item [Value]
Value
"icon", Item [Value]
Value
"title"]
            , [Item [Value]
Value
"icon", Item [Value]
Value
"secondary"]
            ]
        Selector
".icon" Selector -> Css -> Css
? (Key Text
"grid-area" Key Text -> Text -> Css
-: Text
"icon")
        Selector
".title" Selector -> Css -> Css
? (Key Text
"grid-area" Key Text -> Text -> Css
-: Text
"title")
        Selector
".secondary" Selector -> Css -> Css
? (Key Text
"grid-area" Key Text -> Text -> Css
-: Text
"secondary")
        SizeToken -> Css
rowGap' SizeToken
XSmall
    [Size LengthUnit] -> Css
forall a. [Size a] -> Css
gridTemplateColumns [Number -> Size LengthUnit
em Number
1.5, Item [Size LengthUnit]
Size LengthUnit
forall a. Auto a => a
auto]
    SizeToken -> Css
columnGap' SizeToken
Small
    Selector
".title" Selector -> Css -> Css
? do
        SizeToken -> Css
fontSize' SizeToken
Large
        FontWeight -> Css
fontWeight (FontWeight -> Css) -> FontWeight -> Css
forall a b. (a -> b) -> a -> b
$ Integer -> FontWeight
weight Integer
700
    Selector
".icon" Selector -> Css -> Css
? do
        Size Percentage -> Css
forall a. Size a -> Css
fontSize (Number -> Size Percentage
pct Number
150)
        AlignSelfValue -> Css
alignSelf AlignSelfValue
forall a. Baseline a => a
baseline
    Refinement -> Refinement
forall a. Not a => a -> Refinement
Clay.not (Selector -> Refinement
has Selector
".title") Refinement -> Css -> Css
& Selector
".icon" Selector -> Css -> Css
? do
        Position -> Css
position Position
relative
        Size LengthUnit -> Css
forall a. Size a -> Css
top (Size LengthUnit -> Css)
-> (Number -> Size LengthUnit) -> Number -> 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
. Number -> Size LengthUnit
em (Number -> Css) -> Number -> Css
forall a b. (a -> b) -> a -> b
$ -Number
0.05

defaultIcon :: Appearance -> Maybe Icon
defaultIcon :: Appearance -> Maybe Icon
defaultIcon Appearance
Default = Maybe Icon
forall a. Maybe a
Nothing
defaultIcon Appearance
Primary = Icon -> Maybe Icon
forall a. a -> Maybe a
Just (Icon -> Maybe Icon) -> Icon -> Maybe Icon
forall a b. (a -> b) -> a -> b
$ Weight -> Phosphor -> Icon
Icon Weight
Fill Phosphor
Info
defaultIcon Appearance
Subtle = Maybe Icon
forall a. Maybe a
Nothing
defaultIcon Appearance
Success = Icon -> Maybe Icon
forall a. a -> Maybe a
Just (Icon -> Maybe Icon) -> Icon -> Maybe Icon
forall a b. (a -> b) -> a -> b
$ Weight -> Phosphor -> Icon
Icon Weight
Fill Phosphor
CheckCircle
defaultIcon Appearance
Warning = Icon -> Maybe Icon
forall a. a -> Maybe a
Just (Icon -> Maybe Icon) -> Icon -> Maybe Icon
forall a b. (a -> b) -> a -> b
$ Weight -> Phosphor -> Icon
Icon Weight
Fill Phosphor
Icon.Warning
defaultIcon Appearance
Danger = Icon -> Maybe Icon
forall a. a -> Maybe a
Just (Icon -> Maybe Icon) -> Icon -> Maybe Icon
forall a b. (a -> b) -> a -> b
$ Weight -> Phosphor -> Icon
Icon Weight
Fill Phosphor
WarningDiamond
defaultIcon Appearance
Discovery = Icon -> Maybe Icon
forall a. a -> Maybe a
Just (Icon -> Maybe Icon) -> Icon -> Maybe Icon
forall a b. (a -> b) -> a -> b
$ Weight -> Phosphor -> Icon
Icon Weight
Fill Phosphor
Question

appearanceStyle :: Appearance -> Css
appearanceStyle :: Appearance -> Css
appearanceStyle Appearance
appearance = do
    MessageSize -> Refinement
forall t. Token t => t -> Refinement
byToken MessageSize
FormMessage Refinement -> Css -> Css
& TextColour -> Css
forall t. Token t => t -> Css
color' (Appearance -> TextColour
TextColour Appearance
appearance)
    MessageSize -> Refinement
forall t. Token t => t -> Refinement
byToken MessageSize
SectionMessage Refinement -> Css -> Css
& BackgroundColour -> Css
forall t. Token t => t -> Css
backgroundColor' (Appearance -> BackgroundColour
BackgroundColour Appearance
appearance)
    Selector
".icon" Selector -> Css -> Css
? TextColour -> Css
forall t. Token t => t -> Css
color' (Appearance -> TextColour
TextColour Appearance
appearance)

instance Widget Message model action where
    widget' :: [Attribute action] -> Message -> View model action
widget' [Attribute action]
attrs Message{Maybe Text
Maybe MessageIcon
Appearance
MessageSize
size :: Message -> MessageSize
appearance :: Message -> Appearance
icon :: Message -> Maybe MessageIcon
title :: Message -> Maybe Text
secondary :: Message -> Maybe Text
size :: MessageSize
appearance :: Appearance
icon :: Maybe MessageIcon
title :: Maybe Text
secondary :: Maybe Text
..} =
        [Attribute action] -> [View model action] -> View model action
tag (Text -> Attribute action
forall action. Text -> Attribute action
class_ Text
"message" Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MessageSize -> Attribute action
forall t action. Token t => t -> Attribute action
forall action. MessageSize -> Attribute action
tokenAttr MessageSize
size Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: Appearance -> Attribute action
forall action. Appearance -> Attribute action
forall t action. Token t => t -> Attribute action
tokenAttr Appearance
appearance Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs)
            ([View model action] -> View model action)
-> ([Maybe (View model action)] -> [View model action])
-> [Maybe (View model action)]
-> 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 (View model action)] -> [View model action]
forall a. [Maybe a] -> [a]
catMaybes
            ([Maybe (View model action)] -> View model action)
-> [Maybe (View model action)] -> View model action
forall a b. (a -> b) -> a -> b
$ [ Icon -> View model action
forall w model action.
Widget w model action =>
w -> View model action
widget (Icon -> View model action)
-> Maybe Icon -> Maybe (View model action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Icon
icon'
              , [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
span_ [Text -> Attribute action
forall action. Text -> Attribute action
class_ Text
"title"] ([View model action] -> View model action)
-> (Text -> [View model action]) -> Text -> 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
. View model action -> [View model action]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (View model action -> [View model action])
-> (Text -> View model action) -> Text -> [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
. Text -> View model action
forall model action. Text -> View model action
text (Text -> View model action)
-> Maybe Text -> Maybe (View model action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
title
              , [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
span_ [Text -> Attribute action
forall action. Text -> Attribute action
class_ Text
"secondary"] ([View model action] -> View model action)
-> (Text -> [View model action]) -> Text -> 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
. View model action -> [View model action]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (View model action -> [View model action])
-> (Text -> View model action) -> Text -> [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
. Text -> View model action
forall model action. Text -> View model action
text (Text -> View model action)
-> Maybe Text -> Maybe (View model action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
secondary
              ]
      where
        icon' :: Maybe Icon
icon' =
            Maybe MessageIcon
icon Maybe MessageIcon -> (MessageIcon -> Maybe Icon) -> Maybe Icon
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                MessageIcon
DefaultIcon -> Appearance -> Maybe Icon
defaultIcon Appearance
appearance
                CustomIcon Icon
i -> Icon -> Maybe Icon
forall a. a -> Maybe a
Just Icon
i
        tag :: [Attribute action] -> [View model action] -> View model action
tag
            | MessageSize
size MessageSize -> MessageSize -> Bool
forall a. Eq a => a -> a -> Bool
== MessageSize
InlineMessage = [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
a_ ([Attribute action] -> [View model action] -> View model action)
-> ([Attribute action] -> [Attribute action])
-> [Attribute action]
-> [View model action]
-> 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
. (Attribute action
forall action. Attribute action
selectable_ Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
:)
            | Bool
otherwise = [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
div_

    style :: Css
style =
        Selector
".message" Selector -> Css -> Css
? do
            Size Percentage -> Css
forall a. Size a -> Css
maxWidth (Size Percentage -> Css) -> Size Percentage -> Css
forall a b. (a -> b) -> a -> b
$ Number -> Size Percentage
pct Number
100
            (MessageSize -> Css) -> Css
forall t. Token t => (t -> Css) -> Css
byTokens MessageSize -> Css
sizeStyle
            (Appearance -> Css) -> Css
forall t. Token t => (t -> Css) -> Css
byTokens Appearance -> Css
appearanceStyle