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] -> (Word8 -> Word8 -> Word8 -> RGB Word8)
-> m (Word8 -> Word8 -> Word8 -> RGB Word8)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8 -> Word8 -> Word8 -> RGB Word8
forall a. a -> a -> a -> RGB a
RGB m (Word8 -> Word8 -> Word8 -> RGB Word8)
-> m Word8 -> m (Word8 -> Word8 -> RGB Word8)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Char -> m Word8
w Char
a Char
b m (Word8 -> Word8 -> RGB Word8)
-> m Word8 -> m (Word8 -> RGB Word8)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Char -> m Word8
w Char
c Char
d m (Word8 -> RGB Word8) -> m Word8 -> m (RGB Word8)
forall a b. m (a -> b) -> m a -> m b
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 = (m Word8 -> (Word8 -> m Word8) -> Maybe Word8 -> m Word8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m Word8
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid characters in CSS RGB value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
text)) Word8 -> m Word8
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Maybe Word8 -> m Word8) -> Maybe Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Maybe Word8
hexWord8Maybe Char
c1 Char
c2
  Char
'#' : String
_ -> String -> m (RGB Word8)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (RGB Word8)) -> String -> m (RGB Word8)
forall a b. (a -> b) -> a -> b
$ String
"Invalid CSS RGB value: Must be six hex characters, but is " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
text
  [] -> String -> m (RGB Word8)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid CSS RGB value: Empty string"
  String
_ -> String -> m (RGB Word8)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (RGB Word8)) -> String -> m (RGB Word8)
forall a b. (a -> b) -> a -> b
$ String
"Invalid CSS RGB value: Only hex format is supported (must start with #), but got: " String -> String -> String
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 ReadS Word8
forall a. (Eq a, Num a) => ReadS a
Numeric.readHex [Char
a, Char
b] of [(Word8
x, String
"")] -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
x; [(Word8, String)]
_ -> Maybe Word8
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
'#' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Word8 -> Text) -> [Word8] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Word8
x -> String -> Text
Text.pack (String -> String
pad (Word8 -> String -> String
forall a. Integral 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" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    (String -> Text
Text.pack (String -> Text) -> (Word8 -> String) -> Word8 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> String
forall a. Show a => a -> String
Show.show (Word8 -> Text) -> [Word8] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8
r, Word8
g, Word8
b]) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"0"]

function :: Text -> [Text] -> Text
function :: Text -> [Text] -> Text
function Text
name [Text]
args = Text
name Text -> Text -> Text
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
'(' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
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