{-# OPTIONS_GHC -Wno-missing-role-annotations #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Dashi.Style.Colour
    ( module Dashi.Style.Colour
    , module Graphics.Color.Space
    , module Graphics.Color.Space.OKLAB.LCH
    , module Graphics.Color.Space.RGB.SRGB
    , module Graphics.Color.Adaptation.VonKries
    )
where

import Clay qualified
import Control.Lens (Iso', iso)
import Data.Bifunctor (first)
import Data.Bool (bool)
import Data.Char (toUpper)
import Data.Either.Extra (eitherToMaybe, maybeToEither)
import Data.Fixed (Fixed, HasResolution, showFixed)
import Data.List qualified as List
import Data.String (IsString, fromString)
import Data.Word (Word8)
import Graphics.Color.Adaptation.VonKries (convert)
import Graphics.Color.Space
    ( Alpha
    , ColorSpace
    , Elevator
    , Linearity (..)
    , addAlpha
    , convertColor
    , dropAlpha
    , getAlpha
    , setAlpha
    , toShowS
    )
import Graphics.Color.Space.OKLAB.LCH
import Graphics.Color.Space.RGB.SRGB
import Miso.JSON (FromJSON (..), Parser (..), ToJSON (..), withText)
import Miso.Prelude
import Miso.String (FromMisoString (..), ToMisoString (..))
import Numeric (showHex)

type Colour = Color OKLCH

type AlphaColour = Color (Alpha OKLCH)

data Scheme = Light | Dark
    deriving stock (Scheme -> Scheme -> Bool
(Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool) -> Eq Scheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
/= :: Scheme -> Scheme -> Bool
Eq, Int -> Scheme -> ShowS
[Scheme] -> ShowS
Scheme -> String
(Int -> Scheme -> ShowS)
-> (Scheme -> String) -> ([Scheme] -> ShowS) -> Show Scheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scheme -> ShowS
showsPrec :: Int -> Scheme -> ShowS
$cshow :: Scheme -> String
show :: Scheme -> String
$cshowList :: [Scheme] -> ShowS
showList :: [Scheme] -> ShowS
Show, Scheme
Scheme -> Scheme -> Bounded Scheme
forall a. a -> a -> Bounded a
$cminBound :: Scheme
minBound :: Scheme
$cmaxBound :: Scheme
maxBound :: Scheme
Bounded, Int -> Scheme
Scheme -> Int
Scheme -> [Scheme]
Scheme -> Scheme
Scheme -> Scheme -> [Scheme]
Scheme -> Scheme -> Scheme -> [Scheme]
(Scheme -> Scheme)
-> (Scheme -> Scheme)
-> (Int -> Scheme)
-> (Scheme -> Int)
-> (Scheme -> [Scheme])
-> (Scheme -> Scheme -> [Scheme])
-> (Scheme -> Scheme -> [Scheme])
-> (Scheme -> Scheme -> Scheme -> [Scheme])
-> Enum Scheme
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 :: Scheme -> Scheme
succ :: Scheme -> Scheme
$cpred :: Scheme -> Scheme
pred :: Scheme -> Scheme
$ctoEnum :: Int -> Scheme
toEnum :: Int -> Scheme
$cfromEnum :: Scheme -> Int
fromEnum :: Scheme -> Int
$cenumFrom :: Scheme -> [Scheme]
enumFrom :: Scheme -> [Scheme]
$cenumFromThen :: Scheme -> Scheme -> [Scheme]
enumFromThen :: Scheme -> Scheme -> [Scheme]
$cenumFromTo :: Scheme -> Scheme -> [Scheme]
enumFromTo :: Scheme -> Scheme -> [Scheme]
$cenumFromThenTo :: Scheme -> Scheme -> Scheme -> [Scheme]
enumFromThenTo :: Scheme -> Scheme -> Scheme -> [Scheme]
Enum)

instance FromMisoString Scheme where
    fromMisoStringEither :: MisoString -> Either String Scheme
fromMisoStringEither MisoString
s =
        String -> Maybe Scheme -> Either String Scheme
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"invalid colour scheme"
            (Maybe Scheme -> Either String Scheme)
-> Maybe Scheme -> Either String Scheme
forall a b. (a -> b) -> a -> b
$ (Scheme -> Bool) -> [Scheme] -> Maybe Scheme
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((MisoString
s MisoString -> MisoString -> Bool
forall a. Eq a => a -> a -> Bool
==) (MisoString -> Bool) -> (Scheme -> MisoString) -> Scheme -> Bool
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
. Scheme -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString) [Scheme
forall a. Bounded a => a
minBound .. Scheme
forall a. Bounded a => a
maxBound]

instance ToMisoString Scheme where
    toMisoString :: Scheme -> MisoString
toMisoString Scheme
Light = MisoString
"light"
    toMisoString Scheme
Dark = MisoString
"dark"

instance FromJSON Scheme where
    parseJSON :: Value -> Parser Scheme
parseJSON = MisoString
-> (MisoString -> Parser Scheme) -> Value -> Parser Scheme
forall a.
MisoString -> (MisoString -> Parser a) -> Value -> Parser a
withText MisoString
"Colour.Scheme" ((MisoString -> Parser Scheme) -> Value -> Parser Scheme)
-> (MisoString -> Parser Scheme) -> Value -> Parser Scheme
forall a b. (a -> b) -> a -> b
$ Either MisoString Scheme -> Parser Scheme
forall a. Either MisoString a -> Parser a
Parser (Either MisoString Scheme -> Parser Scheme)
-> (MisoString -> Either MisoString Scheme)
-> MisoString
-> Parser Scheme
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
. (String -> MisoString)
-> Either String Scheme -> Either MisoString Scheme
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (Either String Scheme -> Either MisoString Scheme)
-> (MisoString -> Either String Scheme)
-> MisoString
-> Either MisoString Scheme
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 -> Either String Scheme
forall t. FromMisoString t => MisoString -> Either String t
fromMisoStringEither

instance ToJSON Scheme where
    toJSON :: Scheme -> Value
toJSON = MisoString -> Value
forall a. ToJSON a => a -> Value
toJSON (MisoString -> Value) -> (Scheme -> MisoString) -> Scheme -> Value
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
. Scheme -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString

instance FromJSVal Scheme where
    fromJSVal :: JSVal -> IO (Maybe Scheme)
fromJSVal = (Maybe MisoString -> Maybe Scheme)
-> IO (Maybe MisoString) -> IO (Maybe Scheme)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either String Scheme -> Maybe Scheme
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String Scheme -> Maybe Scheme)
-> (MisoString -> Either String Scheme)
-> MisoString
-> Maybe Scheme
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 -> Either String Scheme
forall t. FromMisoString t => MisoString -> Either String t
fromMisoStringEither (MisoString -> Maybe Scheme) -> Maybe MisoString -> Maybe Scheme
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO (Maybe MisoString) -> IO (Maybe Scheme))
-> (JSVal -> IO (Maybe MisoString)) -> JSVal -> IO (Maybe Scheme)
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
. JSVal -> IO (Maybe MisoString)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal

instance ToJSVal Scheme where
    toJSVal :: Scheme -> IO JSVal
toJSVal = MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (MisoString -> IO JSVal)
-> (Scheme -> MisoString) -> Scheme -> IO JSVal
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
. Scheme -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString

isDark :: Iso' Scheme Bool
isDark :: Iso' Scheme Bool
isDark = (Scheme -> Bool) -> (Bool -> Scheme) -> Iso' Scheme Bool
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (Scheme -> Scheme -> Bool
forall a. Eq a => a -> a -> Bool
== Scheme
Dark) (Scheme -> Scheme -> Bool -> Scheme
forall a. a -> a -> Bool -> a
bool Scheme
Light Scheme
Dark)

data LightDark c = LightDark {forall c. LightDark c -> c
light :: c, forall c. LightDark c -> c
dark :: c}

sameLightDark :: c -> LightDark c
sameLightDark :: forall c. c -> LightDark c
sameLightDark c
c = c -> c -> LightDark c
forall c. c -> c -> LightDark c
LightDark c
c c
c

complementaryLightDark
    :: (Num e)
    => Color (Alpha OKLCH) e
    -> LightDark (Color (Alpha OKLCH) e)
complementaryLightDark :: forall e.
Num e =>
Color (Alpha OKLCH) e -> LightDark (Color (Alpha OKLCH) e)
complementaryLightDark light :: Color (Alpha OKLCH) e
light@(ColorOKLCHA e
l e
c e
h e
a) = Color (Alpha OKLCH) e
-> Color (Alpha OKLCH) e -> LightDark (Color (Alpha OKLCH) e)
forall c. c -> c -> LightDark c
LightDark Color (Alpha OKLCH) e
light (Color (Alpha OKLCH) e -> LightDark (Color (Alpha OKLCH) e))
-> Color (Alpha OKLCH) e -> LightDark (Color (Alpha OKLCH) e)
forall a b. (a -> b) -> a -> b
$ e -> e -> e -> e -> Color (Alpha OKLCH) e
forall e. e -> e -> e -> e -> Color (Alpha OKLCH) e
ColorOKLCHA (e
1 e -> e -> e
forall a. Num a => a -> a -> a
- e
l) e
c e
h e
a

flipLightDark :: LightDark c -> LightDark c
flipLightDark :: forall c. LightDark c -> LightDark c
flipLightDark LightDark{c
light :: forall c. LightDark c -> c
dark :: forall c. LightDark c -> c
light :: c
dark :: c
..} = LightDark{light :: c
light = c
dark, dark :: c
dark = c
light}

getLightDark :: Scheme -> LightDark c -> c
getLightDark :: forall c. Scheme -> LightDark c -> c
getLightDark Scheme
Light = LightDark c -> c
forall c. LightDark c -> c
light
getLightDark Scheme
Dark = LightDark c -> c
forall c. LightDark c -> c
dark

instance Functor LightDark where
    a -> b
f fmap :: forall a b. (a -> b) -> LightDark a -> LightDark b
`fmap` LightDark{a
light :: forall c. LightDark c -> c
dark :: forall c. LightDark c -> c
light :: a
dark :: a
..} = LightDark{light :: b
light = a -> b
f a
light, dark :: b
dark = a -> b
f a
dark}

convertAlphaColor
    :: forall cs cs' i e
     . (ColorSpace cs' i e, ColorSpace cs i e)
    => Color (Alpha cs') e -> Color (Alpha cs) e
convertAlphaColor :: forall {k} cs cs' (i :: k) e.
(ColorSpace cs' i e, ColorSpace cs i e) =>
Color (Alpha cs') e -> Color (Alpha cs) e
convertAlphaColor Color (Alpha cs') e
c = Color cs e -> e -> Color (Alpha cs) e
forall cs e. Color cs e -> e -> Color (Alpha cs) e
addAlpha (Color cs' e -> Color cs e
forall {k} cs cs' (i :: k) e.
(ColorSpace cs' i e, ColorSpace cs i e) =>
Color cs' e -> Color cs e
convertColor (Color cs' e -> Color cs e)
-> (Color (Alpha cs') e -> Color cs' e)
-> Color (Alpha cs') e
-> Color cs e
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
. Color (Alpha cs') e -> Color cs' e
forall cs e. Color (Alpha cs) e -> Color cs e
dropAlpha (Color (Alpha cs') e -> Color cs e)
-> Color (Alpha cs') e -> Color cs e
forall a b. (a -> b) -> a -> b
$ Color (Alpha cs') e
c) (Color (Alpha cs') e -> e
forall cs e. Color (Alpha cs) e -> e
getAlpha Color (Alpha cs') e
c)

fn' :: (IsString s) => String -> [String] -> s
fn' :: forall s. IsString s => String -> [String] -> s
fn' String
name [String]
args = String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> ([String] -> String) -> [String] -> 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
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> s) -> [String] -> s
forall a b. (a -> b) -> a -> b
$ [String
name, String
"(", [String] -> String
unwords [String]
args, String
")"]

fn :: (IsString s) => String -> [ShowS] -> s
fn :: forall s. IsString s => String -> [ShowS] -> s
fn String
name [ShowS]
args = String -> [String] -> s
forall s. IsString s => String -> [String] -> s
fn' String
name (ShowS -> String
showMilli (ShowS -> String) -> [ShowS] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ShowS]
args)
  where
    showMilli :: ShowS -> String
    showMilli :: ShowS -> String
showMilli = ShowS
shorten ShowS -> (ShowS -> String) -> ShowS -> String
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
. Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
8 ShowS -> (ShowS -> String) -> ShowS -> String
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
. (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"")
    shorten :: String -> String
    shorten :: ShowS
shorten String
s
        | Char
'.' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') ShowS -> ShowS -> ShowS
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 -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
s
        | Bool
otherwise = String
s

instance (Num e, Elevator e) => Clay.Val (Color (SRGB l) e) where
    value :: Color (SRGB l) e -> Clay.Value
    value :: Color (SRGB l) e -> Value
value (ColorSRGB ((e
255 e -> e -> e
forall a. Num a => a -> a -> a
*) -> e
r) ((e
255 e -> e -> e
forall a. Num a => a -> a -> a
*) -> e
g) ((e
255 e -> e -> e
forall a. Num a => a -> a -> a
*) -> e
b)) =
        String -> [ShowS] -> Value
forall s. IsString s => String -> [ShowS] -> s
fn String
"rgb" [e -> ShowS
forall e. Elevator e => e -> ShowS
toShowS e
r, e -> ShowS
forall e. Elevator e => e -> ShowS
toShowS e
g, e -> ShowS
forall e. Elevator e => e -> ShowS
toShowS e
b]

instance (Num e, Elevator e) => Clay.Val (Color (Alpha (SRGB l)) e) where
    value :: Color (Alpha (SRGB l)) e -> Clay.Value
    value :: Color (Alpha (SRGB l)) e -> Value
value (ColorSRGBA ((e
255 e -> e -> e
forall a. Num a => a -> a -> a
*) -> e
r) ((e
255 e -> e -> e
forall a. Num a => a -> a -> a
*) -> e
g) ((e
255 e -> e -> e
forall a. Num a => a -> a -> a
*) -> e
b) e
a) =
        String -> [ShowS] -> Value
forall s. IsString s => String -> [ShowS] -> s
fn String
"rgb"
            ([ShowS] -> Value) -> [ShowS] -> Value
forall a b. (a -> b) -> a -> b
$ [e -> ShowS
forall e. Elevator e => e -> ShowS
toShowS e
r, e -> ShowS
forall e. Elevator e => e -> ShowS
toShowS e
g, e -> ShowS
forall e. Elevator e => e -> ShowS
toShowS e
b]
            [ShowS] -> [ShowS] -> [ShowS]
forall a. Semigroup a => a -> a -> a
<> if e
a e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
1 then [] else [Char -> ShowS
showChar Char
'/', e -> ShowS
forall e. Elevator e => e -> ShowS
toShowS e
a]

-- instance (Elevator e) => Clay.Val (Color OKLCH e) where
--     value :: Color OKLCH e -> Clay.Value
--     value (ColorOKLCH l c h) = fn "oklch" [toShowS l, toShowS c, toShowS h]

instance (HasResolution a) => Clay.Val (Color OKLCH (Fixed a)) where
    value :: Color OKLCH (Fixed a) -> Clay.Value
    value :: Color OKLCH (Fixed a) -> Value
value (ColorOKLCH Fixed a
l Fixed a
c Fixed a
h) = String -> [String] -> Value
forall s. IsString s => String -> [String] -> s
fn' String
"oklch" [Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
l, Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
c, Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
h]

-- instance (Elevator e) => Clay.Val (Color (Alpha OKLCH) e) where
--     value :: Color (Alpha OKLCH) e -> Clay.Value
--     value (ColorOKLCHA l c h a) =
--         fn "oklch"
--             $ [toShowS l, toShowS c, toShowS h]
--             <> if a == 1 then [] else [showChar '/', toShowS a]

instance (HasResolution a) => Clay.Val (Color (Alpha OKLCH) (Fixed a)) where
    value :: Color (Alpha OKLCH) (Fixed a) -> Clay.Value
    value :: Color (Alpha OKLCH) (Fixed a) -> Value
value (ColorOKLCHA Fixed a
l Fixed a
c Fixed a
h Fixed a
a) =
        String -> [String] -> Value
forall s. IsString s => String -> [String] -> s
fn' String
"oklch"
            ([String] -> Value) -> [String] -> Value
forall a b. (a -> b) -> a -> b
$ [Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
l, Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
c, Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
h]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
a | Fixed a
a Fixed a -> Fixed a -> Bool
forall a. Eq a => a -> a -> Bool
/= Fixed a
1]

instance (Clay.Val c, Eq c) => Clay.Val (LightDark c) where
    value :: LightDark c -> Clay.Value
    value :: LightDark c -> Value
value LightDark{c
light :: forall c. LightDark c -> c
dark :: forall c. LightDark c -> c
light :: c
dark :: c
..}
        | c
light c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
dark = c -> Value
forall a. Val a => a -> Value
Clay.value c
light
        | Bool
otherwise = Value
"light-dark(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> c -> Value
forall a. Val a => a -> Value
Clay.value c
light Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
"," Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> c -> Value
forall a. Val a => a -> Value
Clay.value c
dark Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")"

-- instance (Num e, Elevator e) => ToMisoString (Color (SRGB l) e) where
--     toMisoString :: Color (SRGB l) e -> MisoString
--     toMisoString (ColorSRGB ((255 *) -> r) ((255 *) -> g) ((255 *) -> b)) =
--         fn "rgb" [toShowS r, toShowS g, toShowS b]

instance (HasResolution a) => ToMisoString (Color (SRGB l) (Fixed a)) where
    toMisoString :: Color (SRGB l) (Fixed a) -> MisoString
    toMisoString :: Color (SRGB l) (Fixed a) -> MisoString
toMisoString (ColorSRGB ((Fixed a
255 Fixed a -> Fixed a -> Fixed a
forall a. Num a => a -> a -> a
*) -> Fixed a
r) ((Fixed a
255 Fixed a -> Fixed a -> Fixed a
forall a. Num a => a -> a -> a
*) -> Fixed a
g) ((Fixed a
255 Fixed a -> Fixed a -> Fixed a
forall a. Num a => a -> a -> a
*) -> Fixed a
b)) =
        String -> [String] -> MisoString
forall s. IsString s => String -> [String] -> s
fn' String
"rgb" [Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
r, Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
g, Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
b]

-- instance (Num e, Elevator e) => ToMisoString (Color (Alpha (SRGB l)) e) where
--     toMisoString :: Color (Alpha (SRGB l)) e -> MisoString
--     toMisoString (ColorSRGBA ((255 *) -> r) ((255 *) -> g) ((255 *) -> b) a) =
--         fn "rgb"
--             $ [toShowS r, toShowS g, toShowS b]
--             <> if a == 1 then [] else [showChar '/', toShowS a]

instance (HasResolution a) => ToMisoString (Color (Alpha (SRGB l)) (Fixed a)) where
    toMisoString :: Color (Alpha (SRGB l)) (Fixed a) -> MisoString
    toMisoString :: Color (Alpha (SRGB l)) (Fixed a) -> MisoString
toMisoString (ColorSRGBA ((Fixed a
255 Fixed a -> Fixed a -> Fixed a
forall a. Num a => a -> a -> a
*) -> Fixed a
r) ((Fixed a
255 Fixed a -> Fixed a -> Fixed a
forall a. Num a => a -> a -> a
*) -> Fixed a
g) ((Fixed a
255 Fixed a -> Fixed a -> Fixed a
forall a. Num a => a -> a -> a
*) -> Fixed a
b) Fixed a
a) =
        String -> [String] -> MisoString
forall s. IsString s => String -> [String] -> s
fn' String
"rgb"
            ([String] -> MisoString) -> [String] -> MisoString
forall a b. (a -> b) -> a -> b
$ [Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
r, Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
g, Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
b]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
a | Fixed a
a Fixed a -> Fixed a -> Bool
forall a. Eq a => a -> a -> Bool
/= Fixed a
1]

-- instance (Elevator e) => ToMisoString (Color OKLCH e) where
--     toMisoString :: Color OKLCH e -> MisoString
--     toMisoString (ColorOKLCH l c h) = fn "oklch" [toShowS l, toShowS c, toShowS h]

instance (HasResolution a) => ToMisoString (Color OKLCH (Fixed a)) where
    toMisoString :: Color OKLCH (Fixed a) -> MisoString
    toMisoString :: Color OKLCH (Fixed a) -> MisoString
toMisoString (ColorOKLCH Fixed a
l Fixed a
c Fixed a
h) = String -> [String] -> MisoString
forall s. IsString s => String -> [String] -> s
fn' String
"oklch" [Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
l, Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
c, Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
h]

-- instance (Elevator e) => ToMisoString (Color (Alpha OKLCH) e) where
--     toMisoString :: Color (Alpha OKLCH) e -> MisoString
--     toMisoString (ColorOKLCHA l c h a) =
--         fn "oklch"
--             $ [toShowS l, toShowS c, toShowS h]
--             <> if a == 1 then [] else [showChar '/', toShowS a]

instance (HasResolution a) => ToMisoString (Color (Alpha OKLCH) (Fixed a)) where
    toMisoString :: Color (Alpha OKLCH) (Fixed a) -> MisoString
    toMisoString :: Color (Alpha OKLCH) (Fixed a) -> MisoString
toMisoString (ColorOKLCHA Fixed a
l Fixed a
c Fixed a
h Fixed a
a) =
        String -> [String] -> MisoString
forall s. IsString s => String -> [String] -> s
fn' String
"oklch"
            ([String] -> MisoString) -> [String] -> MisoString
forall a b. (a -> b) -> a -> b
$ [Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
l, Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
c, Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
h]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> Fixed a -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True Fixed a
a | Fixed a
a Fixed a -> Fixed a -> Bool
forall a. Eq a => a -> a -> Bool
/= Fixed a
1]

instance (ToMisoString c, Eq c) => ToMisoString (LightDark c) where
    toMisoString :: LightDark c -> MisoString
    toMisoString :: LightDark c -> MisoString
toMisoString LightDark{c
light :: forall c. LightDark c -> c
dark :: forall c. LightDark c -> c
light :: c
dark :: c
..}
        | c
light c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
dark = c -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString c
light
        | Bool
otherwise =
            MisoString
"light-dark(" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> c -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString c
light MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"," MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> c -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString c
dark MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
")"

toClayColor :: (Clay.Val (Color cs e)) => Color cs e -> Clay.Color
toClayColor :: forall cs e. Val (Color cs e) => Color cs e -> Color
toClayColor = Value -> Color
Clay.Other (Value -> Color) -> (Color cs e -> Value) -> Color cs e -> Color
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
. Color cs e -> Value
forall a. Val a => a -> Value
Clay.value

rgbHex :: (ColorSpace cs i e) => Color cs e -> MisoString
rgbHex :: forall {k} cs (i :: k) e.
ColorSpace cs i e =>
Color cs e -> MisoString
rgbHex Color cs e
c = MisoString
"#" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> Double -> MisoString
channel Double
r MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> Double -> MisoString
channel Double
g MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> Double -> MisoString
channel Double
b
  where
    ColorSRGB Double
r Double
g Double
b = forall cs' (i' :: k) e' cs i e.
(ColorSpace cs' i' e', ColorSpace cs i e) =>
Color cs' e' -> Color cs e
forall {k1} {k2} cs' (i' :: k1) e' cs (i :: k2) e.
(ColorSpace cs' i' e', ColorSpace cs i e) =>
Color cs' e' -> Color cs e
convert @_ @_ @_ @(SRGB 'NonLinear) Color cs e
c
    channel :: Double -> MisoString
    channel :: Double -> MisoString
channel = String -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (String -> MisoString)
-> (Double -> String) -> Double -> MisoString
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) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper ShowS -> (Double -> String) -> Double -> String
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
. (Word8 -> ShowS) -> String -> Word8 -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> ShowS
forall a. Integral a => a -> ShowS
showHex String
"" (Word8 -> String) -> (Double -> Word8) -> Double -> String
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. (RealFrac a, Integral b) => a -> b
round @_ @Word8 (Double -> Word8) -> (Double -> Double) -> Double -> Word8
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
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
255)