colour-text (empty) → 0.0.0.0

raw patch · 6 files changed

+150/−0 lines, 6 filesdep +basedep +colourdep +colour-text

Dependencies added: base, colour, colour-text, hedgehog, hspec, hspec-hedgehog, text

Files

changelog.md +1/−0
colour-text.cabal +48/−0
library/Colour/Text/CssRgb.hs +47/−0
license.txt +13/−0
readme.md +3/−0
test/Main.hs +38/−0

+ changelog.md view

@@ -0,0 +1,1 @@+0.0.0.0 (2023-05-27) - Initial release

+ colour-text.cabal view

@@ -0,0 +1,48 @@+cabal-version: 3.0++name: colour-text+version: 0.0.0.0+category: Graphics, Text+synopsis: Print and parse colors++description:+    Provides functions to render and parse color values as text.++license: Apache-2.0+license-file: license.txt++author: Chris Martin+maintainer: Chris Martin, Julie Moronuki++homepage: https://github.com/typeclasses/colour-text+bug-reports: https://github.com/typeclasses/colour-text/issues++extra-source-files: *.md++common base+    default-language: Haskell2010+    ghc-options: -Wall+    default-extensions:+        BlockArguments+        OverloadedStrings+        ScopedTypeVariables+    build-depends:+      , base ^>= 4.15 || ^>= 4.16 || ^>= 4.17 || ^>= 4.18+      , colour ^>= 2.3.6+      , text ^>= 1.2.4 || ^>= 2.0++library+    import: base+    hs-source-dirs: library+    exposed-modules: Colour.Text.CssRgb++test-suite test-colour-text+    import: base+    type: exitcode-stdio-1.0+    hs-source-dirs: test+    main-is: Main.hs+    build-depends:+      , colour-text+      , hedgehog ^>= 1.0.5 || ^>= 1.1 || ^>= 1.2+      , hspec ^>= 2.8.5 || ^>= 2.9 || ^>= 2.10 || ^>= 2.11+      , hspec-hedgehog ^>= 0.0.1

+ library/Colour/Text/CssRgb.hs view

@@ -0,0 +1,47 @@+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 text = case Text.unpack text of+  ['#', a, b, c, d, e, f] -> pure RGB <*> w a b <*> w c d <*> w e f+    where+      w :: Char -> Char -> m Word8+      w c1 c2 = (maybe (fail ("Invalid characters in CSS RGB value: " <> Text.unpack text)) pure) $ hexWord8Maybe c1 c2+  '#' : _ -> fail $ "Invalid CSS RGB value: Must be six hex characters, but is " <> Text.unpack text+  [] -> fail "Invalid CSS RGB value: Empty string"+  _ -> fail $ "Invalid CSS RGB value: Only hex format is supported (must start with #), but got: " <> Text.unpack text++hexWord8Maybe :: Char -> Char -> Maybe Word8+hexWord8Maybe a b = case Numeric.readHex [a, b] of [(x, "")] -> Just x; _ -> Nothing++showHex :: RGB Word8 -> Text+showHex (RGB r g b) =+  Text.singleton '#' <> foldMap (\x -> Text.pack (pad (Numeric.showHex x ""))) [r, g, b]++showDecTransparent :: RGB Word8 -> Text+showDecTransparent (RGB r g b) =+  function "rgba" $+    (Text.pack . Show.show <$> [r, g, b]) <> ["0"]++function :: Text -> [Text] -> Text+function name args = name <> paren (commaSep args)++paren :: Text -> Text+paren x = Text.singleton '(' <> x <> Text.singleton ')'++commaSep :: [Text] -> Text+commaSep = Text.intercalate (Text.pack ", ")++pad :: String -> String+pad cs = case cs of [] -> "00"; [x] -> ['0', x]; x -> x

+ license.txt view

@@ -0,0 +1,13 @@+Copyright 2023 Mission Valley Software LLC++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.

+ readme.md view

@@ -0,0 +1,3 @@+Brief package providing read/show functions for RGB colors+in the hexadecimal form used by CSS (e.g. "#ff0000" for red).+It would make sense to expand upon this package's functionality.

+ test/Main.hs view

@@ -0,0 +1,38 @@+module Main (main) where++import Colour.Text.CssRgb (readHex, showDecTransparent, showHex)+import Data.Colour.RGBSpace (RGB (RGB))+import Data.Word (Word8)+import Hedgehog (Gen, forAll, (===))+import qualified Hedgehog.Gen as Gen+import Test.Hspec (describe, hspec, shouldBe, specify)+import Test.Hspec.Hedgehog (hedgehog)++main :: IO ()+main = hspec $ do+  describe "showHex" $ do+    let colour ~> text = showHex colour `shouldBe` text++    specify "black" $ RGB 0 0 0 ~> "#000000"+    specify "white" $ RGB 255 255 255 ~> "#ffffff"+    specify "off-black" $ RGB 1 1 1 ~> "#010101"+    specify "red" $ RGB 255 0 0 ~> "#ff0000"+    specify "green" $ RGB 0 255 0 ~> "#00ff00"+    specify "blue" $ RGB 0 0 255 ~> "#0000ff"++  describe "showDecTransparent" $ do+    let colour ~> text = showDecTransparent colour `shouldBe` text++    specify "black" $ RGB 0 0 0 ~> "rgba(0, 0, 0, 0)"+    specify "white" $ RGB 255 255 255 ~> "rgba(255, 255, 255, 0)"+    specify "red" $ RGB 255 0 0 ~> "rgba(255, 0, 0, 0)"+    specify "green" $ RGB 0 255 0 ~> "rgba(0, 255, 0, 0)"+    specify "blue" $ RGB 0 0 255 ~> "rgba(0, 0, 255, 0)"++  describe "readHex" $ do+    specify "is showHex's inverse" $ hedgehog do+      colour <- forAll genColour+      readHex (showHex colour) === Just colour++genColour :: Gen (RGB Word8)+genColour = RGB <$> Gen.enumBounded <*> Gen.enumBounded <*> Gen.enumBounded