module Colour.Text.CssRgb
  ( readHex,
    showHex,
    showDecTransparent,
  )
where

import Data.Colour.RGBSpace (RGB (..))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Word (Word8)
import qualified Numeric
import qualified Text.Show as Show

readHex :: forall m. MonadFail m => Text -> m (RGB Word8)
readHex :: forall (m :: * -> *). MonadFail m => Text -> m (RGB Word8)
readHex Text
text = case Text -> String
Text.unpack Text
text of
  [Char
'#', Char
a, Char
b, Char
c, Char
d, Char
e, Char
f] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a -> a -> RGB a
RGB forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Char -> m Word8
w Char
a Char
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Char -> m Word8
w Char
c Char
d forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Char -> m Word8
w Char
e Char
f
    where
      w :: Char -> Char -> m Word8
      w :: Char -> Char -> m Word8
w Char
c1 Char
c2 = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid characters in CSS RGB value: " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
text)) forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall a b. (a -> b) -> a -> b
$ Char -> Char -> Maybe Word8
hexWord8Maybe Char
c1 Char
c2
  Char
'#' : String
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid CSS RGB value: Must be six hex characters, but is " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
text
  [] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid CSS RGB value: Empty string"
  String
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid CSS RGB value: Only hex format is supported (must start with #), but got: " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
text

hexWord8Maybe :: Char -> Char -> Maybe Word8
hexWord8Maybe :: Char -> Char -> Maybe Word8
hexWord8Maybe Char
a Char
b = case forall a. (Eq a, Num a) => ReadS a
Numeric.readHex [Char
a, Char
b] of [(Word8
x, String
"")] -> forall a. a -> Maybe a
Just Word8
x; [(Word8, String)]
_ -> forall a. Maybe a
Nothing

showHex :: RGB Word8 -> Text
showHex :: RGB Word8 -> Text
showHex (RGB Word8
r Word8
g Word8
b) =
  Char -> Text
Text.singleton Char
'#' forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Word8
x -> String -> Text
Text.pack (String -> String
pad (forall a. (Integral a, Show a) => a -> String -> String
Numeric.showHex Word8
x String
""))) [Word8
r, Word8
g, Word8
b]

showDecTransparent :: RGB Word8 -> Text
showDecTransparent :: RGB Word8 -> Text
showDecTransparent (RGB Word8
r Word8
g Word8
b) =
  Text -> [Text] -> Text
function Text
"rgba" forall a b. (a -> b) -> a -> b
$
    (String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
Show.show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8
r, Word8
g, Word8
b]) forall a. Semigroup a => a -> a -> a
<> [Text
"0"]

function :: Text -> [Text] -> Text
function :: Text -> [Text] -> Text
function Text
name [Text]
args = Text
name forall a. Semigroup a => a -> a -> a
<> Text -> Text
paren ([Text] -> Text
commaSep [Text]
args)

paren :: Text -> Text
paren :: Text -> Text
paren Text
x = Char -> Text
Text.singleton Char
'(' forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton Char
')'

commaSep :: [Text] -> Text
commaSep :: [Text] -> Text
commaSep = Text -> [Text] -> Text
Text.intercalate (String -> Text
Text.pack String
", ")

pad :: String -> String
pad :: String -> String
pad String
cs = case String
cs of [] -> String
"00"; [Char
x] -> [Char
'0', Char
x]; String
x -> String
x