{-# OPTIONS_GHC -fno-warn-orphans #-}
module WWW.Colors.Instances where

import Clay.Color qualified as Clay
import Clay.Property qualified as Clay
import Data.Colour
import Data.Colour.SRGB (toSRGB24, sRGB24, RGB (..))
import Diagrams.Attributes


-- | Not perfect, but good enough for building what I need
instance Color Clay.Color where
    toAlphaColour :: Clay.Color -> AlphaColour Double
    toAlphaColour col = case Clay.toRgba col of
                            Clay.Rgba r g b a ->
                                let rgb = sRGB24 (fromInteger r) (fromInteger g) (fromInteger b)
                                 in alphaColourConvert $ rgb `withOpacity` a
                            _ -> error "Should not happen"

    fromAlphaColour :: AlphaColour Double -> Clay.Color
    fromAlphaColour col =
        let a = alphaChannel $ alphaColourConvert col
            RGB r g b = toInteger <$> toSRGB24 (fromAlphaColour @(Colour Double) col)
         in Clay.rgba r g b a

instance Clay.Val SomeColor where
    value = Clay.value . fromAlphaColour @Clay.Color . someToAlpha