{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingStrategies #-}

module Web.View.Types where

import Data.Map (Map)
import Data.String (IsString (..))
import Data.Text (Text, pack, unpack)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Text.Casing (kebab)


data Content
  = Node Element
  | Text Text
  | -- | Raw embedded HTML or SVG. See 'Web.View.Element.raw'
    Raw Text


-- | A single HTML tag. Note that the class attribute is stored separately from the rest of the attributes to make adding styles easier
data Element = Element
  { Element -> Name
name :: Name
  , Element -> Attributes
attributes :: Attributes
  , Element -> [Content]
children :: [Content]
  }


data Attributes = Attributes
  { Attributes -> [Class]
classes :: [Class]
  , Attributes -> Map Name Name
other :: Map Name AttValue
  }
type Attribute = (Name, AttValue)
type Name = Text
type AttValue = Text


-- * Attribute Modifiers


{- | Element functions expect a Mod function as their first argument that adds attributes and classes.

> userEmail :: User -> View c ()
> userEmail user = input (fontSize 16 . active) (text user.email)
>   where
>     active = isActive user then bold else id
-}
type Mod = Attributes -> Attributes


-- * Atomic CSS


-- TODO: document atomic CSS here?

-- | All the atomic classes used in a 'Web.View.View'
type CSS = Map Selector Class


-- | Atomic classes include a selector and the corresponding styles
data Class = Class
  { Class -> Selector
selector :: Selector
  , Class -> Styles
properties :: Styles
  }


-- | The styles to apply for a given atomic 'Class'
type Styles = Map Name StyleValue


-- | The selector to use for the given atomic 'Class'
data Selector = Selector
  { Selector -> Maybe Name
parent :: Maybe Text
  , Selector -> Maybe Pseudo
pseudo :: Maybe Pseudo
  , Selector -> Maybe Media
media :: Maybe Media
  , Selector -> ClassName
className :: ClassName
  }
  deriving (Selector -> Selector -> Bool
(Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool) -> Eq Selector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
/= :: Selector -> Selector -> Bool
Eq, Eq Selector
Eq Selector
-> (Selector -> Selector -> Ordering)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Selector)
-> (Selector -> Selector -> Selector)
-> Ord Selector
Selector -> Selector -> Bool
Selector -> Selector -> Ordering
Selector -> Selector -> Selector
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Selector -> Selector -> Ordering
compare :: Selector -> Selector -> Ordering
$c< :: Selector -> Selector -> Bool
< :: Selector -> Selector -> Bool
$c<= :: Selector -> Selector -> Bool
<= :: Selector -> Selector -> Bool
$c> :: Selector -> Selector -> Bool
> :: Selector -> Selector -> Bool
$c>= :: Selector -> Selector -> Bool
>= :: Selector -> Selector -> Bool
$cmax :: Selector -> Selector -> Selector
max :: Selector -> Selector -> Selector
$cmin :: Selector -> Selector -> Selector
min :: Selector -> Selector -> Selector
Ord)


instance IsString Selector where
  fromString :: String -> Selector
fromString String
s = Maybe Name -> Maybe Pseudo -> Maybe Media -> ClassName -> Selector
Selector Maybe Name
forall a. Maybe a
Nothing Maybe Pseudo
forall a. Maybe a
Nothing Maybe Media
forall a. Maybe a
Nothing (String -> ClassName
forall a. IsString a => String -> a
fromString String
s)


-- | Create a 'Selector' given only a 'ClassName'
selector :: ClassName -> Selector
selector :: ClassName -> Selector
selector = Maybe Name -> Maybe Pseudo -> Maybe Media -> ClassName -> Selector
Selector Maybe Name
forall a. Maybe a
Nothing Maybe Pseudo
forall a. Maybe a
Nothing Maybe Media
forall a. Maybe a
Nothing


-- | A class name
newtype ClassName = ClassName
  { ClassName -> Name
text :: Text
  }
  deriving newtype (ClassName -> ClassName -> Bool
(ClassName -> ClassName -> Bool)
-> (ClassName -> ClassName -> Bool) -> Eq ClassName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClassName -> ClassName -> Bool
== :: ClassName -> ClassName -> Bool
$c/= :: ClassName -> ClassName -> Bool
/= :: ClassName -> ClassName -> Bool
Eq, Eq ClassName
Eq ClassName
-> (ClassName -> ClassName -> Ordering)
-> (ClassName -> ClassName -> Bool)
-> (ClassName -> ClassName -> Bool)
-> (ClassName -> ClassName -> Bool)
-> (ClassName -> ClassName -> Bool)
-> (ClassName -> ClassName -> ClassName)
-> (ClassName -> ClassName -> ClassName)
-> Ord ClassName
ClassName -> ClassName -> Bool
ClassName -> ClassName -> Ordering
ClassName -> ClassName -> ClassName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ClassName -> ClassName -> Ordering
compare :: ClassName -> ClassName -> Ordering
$c< :: ClassName -> ClassName -> Bool
< :: ClassName -> ClassName -> Bool
$c<= :: ClassName -> ClassName -> Bool
<= :: ClassName -> ClassName -> Bool
$c> :: ClassName -> ClassName -> Bool
> :: ClassName -> ClassName -> Bool
$c>= :: ClassName -> ClassName -> Bool
>= :: ClassName -> ClassName -> Bool
$cmax :: ClassName -> ClassName -> ClassName
max :: ClassName -> ClassName -> ClassName
$cmin :: ClassName -> ClassName -> ClassName
min :: ClassName -> ClassName -> ClassName
Ord, String -> ClassName
(String -> ClassName) -> IsString ClassName
forall a. (String -> a) -> IsString a
$cfromString :: String -> ClassName
fromString :: String -> ClassName
IsString)


-- | Convert a type into a className segment to generate unique compound style names based on the value
class ToClassName a where
  toClassName :: a -> Text
  default toClassName :: (Show a) => a -> Text
  toClassName = Name -> Name
T.toLower (Name -> Name) -> (a -> Name) -> a -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
T.pack (String -> Name) -> (a -> String) -> a -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show


instance ToClassName Int
instance ToClassName Float
instance ToClassName Text where
  toClassName :: Name -> Name
toClassName = Name -> Name
forall a. a -> a
id


{- | Psuedos allow for specifying styles that only apply in certain conditions. See `Web.View.Style.hover` etc

> el (color Primary . hover (color White)) "hello"
-}
data Pseudo
  = Hover
  | Active
  | Even
  | Odd
  deriving (Int -> Pseudo -> ShowS
[Pseudo] -> ShowS
Pseudo -> String
(Int -> Pseudo -> ShowS)
-> (Pseudo -> String) -> ([Pseudo] -> ShowS) -> Show Pseudo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pseudo -> ShowS
showsPrec :: Int -> Pseudo -> ShowS
$cshow :: Pseudo -> String
show :: Pseudo -> String
$cshowList :: [Pseudo] -> ShowS
showList :: [Pseudo] -> ShowS
Show, Pseudo -> Pseudo -> Bool
(Pseudo -> Pseudo -> Bool)
-> (Pseudo -> Pseudo -> Bool) -> Eq Pseudo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pseudo -> Pseudo -> Bool
== :: Pseudo -> Pseudo -> Bool
$c/= :: Pseudo -> Pseudo -> Bool
/= :: Pseudo -> Pseudo -> Bool
Eq, Eq Pseudo
Eq Pseudo
-> (Pseudo -> Pseudo -> Ordering)
-> (Pseudo -> Pseudo -> Bool)
-> (Pseudo -> Pseudo -> Bool)
-> (Pseudo -> Pseudo -> Bool)
-> (Pseudo -> Pseudo -> Bool)
-> (Pseudo -> Pseudo -> Pseudo)
-> (Pseudo -> Pseudo -> Pseudo)
-> Ord Pseudo
Pseudo -> Pseudo -> Bool
Pseudo -> Pseudo -> Ordering
Pseudo -> Pseudo -> Pseudo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Pseudo -> Pseudo -> Ordering
compare :: Pseudo -> Pseudo -> Ordering
$c< :: Pseudo -> Pseudo -> Bool
< :: Pseudo -> Pseudo -> Bool
$c<= :: Pseudo -> Pseudo -> Bool
<= :: Pseudo -> Pseudo -> Bool
$c> :: Pseudo -> Pseudo -> Bool
> :: Pseudo -> Pseudo -> Bool
$c>= :: Pseudo -> Pseudo -> Bool
>= :: Pseudo -> Pseudo -> Bool
$cmax :: Pseudo -> Pseudo -> Pseudo
max :: Pseudo -> Pseudo -> Pseudo
$cmin :: Pseudo -> Pseudo -> Pseudo
min :: Pseudo -> Pseudo -> Pseudo
Ord)


-- | The value of a css style property
newtype StyleValue = StyleValue String
  deriving newtype (String -> StyleValue
(String -> StyleValue) -> IsString StyleValue
forall a. (String -> a) -> IsString a
$cfromString :: String -> StyleValue
fromString :: String -> StyleValue
IsString, Int -> StyleValue -> ShowS
[StyleValue] -> ShowS
StyleValue -> String
(Int -> StyleValue -> ShowS)
-> (StyleValue -> String)
-> ([StyleValue] -> ShowS)
-> Show StyleValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StyleValue -> ShowS
showsPrec :: Int -> StyleValue -> ShowS
$cshow :: StyleValue -> String
show :: StyleValue -> String
$cshowList :: [StyleValue] -> ShowS
showList :: [StyleValue] -> ShowS
Show)


-- | Use a type as a css style property value
class ToStyleValue a where
  toStyleValue :: a -> StyleValue
  default toStyleValue :: (Show a) => a -> StyleValue
  toStyleValue = String -> StyleValue
StyleValue (String -> StyleValue) -> (a -> String) -> a -> StyleValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
kebab ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show


instance ToStyleValue String where
  toStyleValue :: String -> StyleValue
toStyleValue = String -> StyleValue
StyleValue


instance ToStyleValue Text where
  toStyleValue :: Name -> StyleValue
toStyleValue = String -> StyleValue
StyleValue (String -> StyleValue) -> (Name -> String) -> Name -> StyleValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
unpack


instance ToStyleValue Int


-- | Px, converted to Rem. Allows for the user to change the document font size and have the app scale accordingly. But allows the programmer to code in pixels to match a design
newtype PxRem = PxRem Int
  deriving newtype (Int -> PxRem -> ShowS
[PxRem] -> ShowS
PxRem -> String
(Int -> PxRem -> ShowS)
-> (PxRem -> String) -> ([PxRem] -> ShowS) -> Show PxRem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PxRem -> ShowS
showsPrec :: Int -> PxRem -> ShowS
$cshow :: PxRem -> String
show :: PxRem -> String
$cshowList :: [PxRem] -> ShowS
showList :: [PxRem] -> ShowS
Show, PxRem -> Name
(PxRem -> Name) -> ToClassName PxRem
forall a. (a -> Name) -> ToClassName a
$ctoClassName :: PxRem -> Name
toClassName :: PxRem -> Name
ToClassName, Integer -> PxRem
PxRem -> PxRem
PxRem -> PxRem -> PxRem
(PxRem -> PxRem -> PxRem)
-> (PxRem -> PxRem -> PxRem)
-> (PxRem -> PxRem -> PxRem)
-> (PxRem -> PxRem)
-> (PxRem -> PxRem)
-> (PxRem -> PxRem)
-> (Integer -> PxRem)
-> Num PxRem
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: PxRem -> PxRem -> PxRem
+ :: PxRem -> PxRem -> PxRem
$c- :: PxRem -> PxRem -> PxRem
- :: PxRem -> PxRem -> PxRem
$c* :: PxRem -> PxRem -> PxRem
* :: PxRem -> PxRem -> PxRem
$cnegate :: PxRem -> PxRem
negate :: PxRem -> PxRem
$cabs :: PxRem -> PxRem
abs :: PxRem -> PxRem
$csignum :: PxRem -> PxRem
signum :: PxRem -> PxRem
$cfromInteger :: Integer -> PxRem
fromInteger :: Integer -> PxRem
Num)


instance ToStyleValue PxRem where
  toStyleValue :: PxRem -> StyleValue
toStyleValue (PxRem Int
0) = StyleValue
"0px"
  toStyleValue (PxRem Int
1) = StyleValue
"1px"
  toStyleValue (PxRem Int
n) = String -> StyleValue
StyleValue (String -> StyleValue) -> String -> StyleValue
forall a b. (a -> b) -> a -> b
$ Float -> String
forall a. Show a => a -> String
show ((Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Float) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
16.0) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"rem"


-- | Milliseconds, used for transitions
newtype Ms = Ms Int
  deriving (Int -> Ms -> ShowS
[Ms] -> ShowS
Ms -> String
(Int -> Ms -> ShowS)
-> (Ms -> String) -> ([Ms] -> ShowS) -> Show Ms
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ms -> ShowS
showsPrec :: Int -> Ms -> ShowS
$cshow :: Ms -> String
show :: Ms -> String
$cshowList :: [Ms] -> ShowS
showList :: [Ms] -> ShowS
Show)
  deriving newtype (Integer -> Ms
Ms -> Ms
Ms -> Ms -> Ms
(Ms -> Ms -> Ms)
-> (Ms -> Ms -> Ms)
-> (Ms -> Ms -> Ms)
-> (Ms -> Ms)
-> (Ms -> Ms)
-> (Ms -> Ms)
-> (Integer -> Ms)
-> Num Ms
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Ms -> Ms -> Ms
+ :: Ms -> Ms -> Ms
$c- :: Ms -> Ms -> Ms
- :: Ms -> Ms -> Ms
$c* :: Ms -> Ms -> Ms
* :: Ms -> Ms -> Ms
$cnegate :: Ms -> Ms
negate :: Ms -> Ms
$cabs :: Ms -> Ms
abs :: Ms -> Ms
$csignum :: Ms -> Ms
signum :: Ms -> Ms
$cfromInteger :: Integer -> Ms
fromInteger :: Integer -> Ms
Num, Ms -> Name
(Ms -> Name) -> ToClassName Ms
forall a. (a -> Name) -> ToClassName a
$ctoClassName :: Ms -> Name
toClassName :: Ms -> Name
ToClassName)


instance ToStyleValue Ms where
  toStyleValue :: Ms -> StyleValue
toStyleValue (Ms Int
n) = String -> StyleValue
StyleValue (String -> StyleValue) -> String -> StyleValue
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"ms"


-- | Media allows for responsive designs that change based on characteristics of the window. See [Layout Example](https://github.com/seanhess/web-view/blob/master/example/Example/Layout.hs)
data Media
  = MinWidth Int
  | MaxWidth Int
  deriving (Media -> Media -> Bool
(Media -> Media -> Bool) -> (Media -> Media -> Bool) -> Eq Media
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Media -> Media -> Bool
== :: Media -> Media -> Bool
$c/= :: Media -> Media -> Bool
/= :: Media -> Media -> Bool
Eq, Eq Media
Eq Media
-> (Media -> Media -> Ordering)
-> (Media -> Media -> Bool)
-> (Media -> Media -> Bool)
-> (Media -> Media -> Bool)
-> (Media -> Media -> Bool)
-> (Media -> Media -> Media)
-> (Media -> Media -> Media)
-> Ord Media
Media -> Media -> Bool
Media -> Media -> Ordering
Media -> Media -> Media
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Media -> Media -> Ordering
compare :: Media -> Media -> Ordering
$c< :: Media -> Media -> Bool
< :: Media -> Media -> Bool
$c<= :: Media -> Media -> Bool
<= :: Media -> Media -> Bool
$c> :: Media -> Media -> Bool
> :: Media -> Media -> Bool
$c>= :: Media -> Media -> Bool
>= :: Media -> Media -> Bool
$cmax :: Media -> Media -> Media
max :: Media -> Media -> Media
$cmin :: Media -> Media -> Media
min :: Media -> Media -> Media
Ord)


{- | Options for styles that support specifying various sides. This has a "fake" Num instance to support literals

> border 5
> border (X 2)
> border (TRBL 0 5 0 0)
-}
data Sides a
  = All a
  | TRBL a a a a
  | X a
  | Y a
  | XY a a


-- Num instance is just to support literals
instance (Num a) => Num (Sides a) where
  Sides a
a + :: Sides a -> Sides a -> Sides a
+ Sides a
_ = Sides a
a
  Sides a
a * :: Sides a -> Sides a -> Sides a
* Sides a
_ = Sides a
a
  abs :: Sides a -> Sides a
abs Sides a
a = Sides a
a
  negate :: Sides a -> Sides a
negate Sides a
a = Sides a
a
  signum :: Sides a -> Sides a
signum Sides a
a = Sides a
a
  fromInteger :: Integer -> Sides a
fromInteger Integer
n = a -> Sides a
forall a. a -> Sides a
All (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n)


-- | Element's attributes do not include class, which is separated. FlatAttributes generate the class attribute and include it
newtype FlatAttributes = FlatAttributes {FlatAttributes -> Map Name Name
attributes :: Map Name AttValue}
  deriving ((forall x. FlatAttributes -> Rep FlatAttributes x)
-> (forall x. Rep FlatAttributes x -> FlatAttributes)
-> Generic FlatAttributes
forall x. Rep FlatAttributes x -> FlatAttributes
forall x. FlatAttributes -> Rep FlatAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FlatAttributes -> Rep FlatAttributes x
from :: forall x. FlatAttributes -> Rep FlatAttributes x
$cto :: forall x. Rep FlatAttributes x -> FlatAttributes
to :: forall x. Rep FlatAttributes x -> FlatAttributes
Generic)


newtype Url = Url Text
  deriving newtype (String -> Url
(String -> Url) -> IsString Url
forall a. (String -> a) -> IsString a
$cfromString :: String -> Url
fromString :: String -> Url
IsString)


-- ** Colors


{- | ToColor allows you to create a type containing your application's colors:

> data AppColor
>   = White
>   | Primary
>   | Dark
>
> instance ToColor AppColor where
>   colorValue White = "#FFF"
>   colorValue Dark = "#333"
>   colorValue Primary = "#00F"
>
> hello :: View c ()
> hello = el (bg Primary . color White) "Hello"
-}
class ToColor a where
  colorValue :: a -> HexColor
  colorName :: a -> Text
  default colorName :: (Show a) => a -> Text
  colorName = Name -> Name
T.toLower (Name -> Name) -> (a -> Name) -> a -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
pack (String -> Name) -> (a -> String) -> a -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show


instance ToColor HexColor where
  colorValue :: HexColor -> HexColor
colorValue HexColor
c = HexColor
c
  colorName :: HexColor -> Name
colorName (HexColor Name
a) = (Char -> Bool) -> Name -> Name
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') Name
a


-- | Hexidecimal Color. Can be specified with or without the leading '#'. Recommended to use an AppColor type instead of manually using hex colors. See 'Web.View.Types.ToColor'
newtype HexColor = HexColor Text


instance ToStyleValue HexColor where
  toStyleValue :: HexColor -> StyleValue
toStyleValue (HexColor Name
s) = String -> StyleValue
StyleValue (String -> StyleValue) -> String -> StyleValue
forall a b. (a -> b) -> a -> b
$ String
"#" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Name -> String
unpack ((Char -> Bool) -> Name -> Name
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') Name
s)


instance IsString HexColor where
  fromString :: String -> HexColor
fromString = Name -> HexColor
HexColor (Name -> HexColor) -> (String -> Name) -> String -> HexColor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Name -> Name
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') (Name -> Name) -> (String -> Name) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
T.pack