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