module Web.Atomic.Types.ClassName where

import Data.String (IsString (..))
import Data.Text (Text, pack)
import Data.Text qualified as T


-- | A class name
newtype ClassName = ClassName
  { ClassName -> Text
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, Int -> ClassName -> ShowS
[ClassName] -> ShowS
ClassName -> String
(Int -> ClassName -> ShowS)
-> (ClassName -> String)
-> ([ClassName] -> ShowS)
-> Show ClassName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClassName -> ShowS
showsPrec :: Int -> ClassName -> ShowS
$cshow :: ClassName -> String
show :: ClassName -> String
$cshowList :: [ClassName] -> ShowS
showList :: [ClassName] -> ShowS
Show, Semigroup ClassName
ClassName
Semigroup ClassName =>
ClassName
-> (ClassName -> ClassName -> ClassName)
-> ([ClassName] -> ClassName)
-> Monoid ClassName
[ClassName] -> ClassName
ClassName -> ClassName -> ClassName
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: ClassName
mempty :: ClassName
$cmappend :: ClassName -> ClassName -> ClassName
mappend :: ClassName -> ClassName -> ClassName
$cmconcat :: [ClassName] -> ClassName
mconcat :: [ClassName] -> ClassName
Monoid, NonEmpty ClassName -> ClassName
ClassName -> ClassName -> ClassName
(ClassName -> ClassName -> ClassName)
-> (NonEmpty ClassName -> ClassName)
-> (forall b. Integral b => b -> ClassName -> ClassName)
-> Semigroup ClassName
forall b. Integral b => b -> ClassName -> ClassName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ClassName -> ClassName -> ClassName
<> :: ClassName -> ClassName -> ClassName
$csconcat :: NonEmpty ClassName -> ClassName
sconcat :: NonEmpty ClassName -> ClassName
$cstimes :: forall b. Integral b => b -> ClassName -> ClassName
stimes :: forall b. Integral b => b -> ClassName -> ClassName
Semigroup)


instance IsString ClassName where
  fromString :: String -> ClassName
fromString = Text -> ClassName
className (Text -> ClassName) -> (String -> Text) -> String -> ClassName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack


-- | Create a class name, escaping special characters
className :: Text -> ClassName
className :: Text -> ClassName
className = Text -> ClassName
ClassName (Text -> ClassName) -> (Text -> Text) -> Text -> ClassName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
noDot
 where
  noDot :: Char -> Char
noDot Char
'.' = Char
'-'
  noDot Char
c = Char
c


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


instance ToClassName Int
instance ToClassName Text where
  toClassName :: Text -> ClassName
toClassName = Text -> ClassName
className
instance ToClassName Float where
  toClassName :: Float -> ClassName
toClassName Float
f = Text -> ClassName
ClassName (Text -> ClassName) -> Text -> ClassName
forall a b. (a -> b) -> a -> b
$ Text
"p" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round @Float @Int (Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
100))
instance ToClassName ClassName where
  toClassName :: ClassName -> ClassName
toClassName = ClassName -> ClassName
forall a. a -> a
id
instance ToClassName [ClassName] where
  toClassName :: [ClassName] -> ClassName
toClassName [ClassName]
cs = Text -> ClassName
ClassName (Text -> ClassName) -> Text -> ClassName
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"-" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ClassName -> Text) -> [ClassName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.text) [ClassName]
cs
instance ToClassName () where
  toClassName :: () -> ClassName
toClassName ()
_ = ClassName
""


-- | Hyphenate classnames
(-.) :: (ToClassName a) => ClassName -> a -> ClassName
ClassName
cn -. :: forall a. ToClassName a => ClassName -> a -> ClassName
-. a
a = Text -> ClassName -> ClassName -> ClassName
joinClassSegments Text
"-" ClassName
cn (a -> ClassName
forall a. ToClassName a => a -> ClassName
toClassName a
a)


infixl 7 -.


joinClassSegments :: Text -> ClassName -> ClassName -> ClassName
joinClassSegments :: Text -> ClassName -> ClassName -> ClassName
joinClassSegments Text
_ ClassName
"" ClassName
cn = ClassName
cn
joinClassSegments Text
_ ClassName
cn ClassName
"" = ClassName
cn
joinClassSegments Text
sep (ClassName Text
cn1) (ClassName Text
cn2) =
  Text -> ClassName
ClassName (Text -> ClassName) -> Text -> ClassName
forall a b. (a -> b) -> a -> b
$ Text
cn1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cn2


-- modifiers to a class are prepended with ":", like hover\:my-class:hover
addClassState :: (ToClassName a) => a -> ClassName -> ClassName
addClassState :: forall a. ToClassName a => a -> ClassName -> ClassName
addClassState a
a = Text -> ClassName -> ClassName -> ClassName
joinClassSegments Text
":" (a -> ClassName
forall a. ToClassName a => a -> ClassName
toClassName a
a)


-- appendClassSegments :: (ToClassName a) => [a] -> ClassName -> ClassName
-- appendClassSegments as cn = foldl (flip appendClassSegment) cn as

classesAttValue :: [ClassName] -> Text
classesAttValue :: [ClassName] -> Text
classesAttValue [ClassName]
clss =
  [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ClassName -> Text) -> [ClassName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.text) [ClassName]
clss