Trying to write css

1 files changed, 27 insertions, 4 deletions

diff --git a/src/WWW/Colors/QQ.hs b/src/WWW/Colors/QQ.hs
index 4a03dbb..281a93a 100644
--- a/src/WWW/Colors/QQ.hs
+++ b/src/WWW/Colors/QQ.hs
@@ -1,20 +1,43 @@
 {-# LANGUAGE TemplateHaskell #-}
 module WWW.Colors.QQ
     ( hex
+    , Color'
+    , toColor'
+    , someToColor'
     ) where
 
--- import Data.Colour
--- import Data.Colour.SRGB
+import Data.Colour
+import Data.Colour.SRGB
 import Control.Monad ((>=>))
+import Diagrams.Attributes
 import Diagrams.Backend.CmdLine (readHexColor)
+import Language.Haskell.TH.Syntax
 import Language.Haskell.TH.Quote
 
 
+-- | data type defined so we can use template haskell to get compile-time hex colors
+data Color' = Color' !Double !Double !Double !Double
+    deriving Lift
 
--- | QuasiQuoter which reads in a hex color code and ouputs a 'AlphaColour Double'.
+instance Color Color' where
+    toAlphaColour (Color' r g b a) = withOpacity (sRGB r g b) a
+    fromAlphaColour col =
+        let a = alphaChannel col
+            RGB r g b = toSRGB $ fromAlphaColour @(Colour Double) col
+         in Color' r g b a
+
+
+toColor' :: AlphaColour Double -> Color'
+toColor' = fromAlphaColour
+
+someToColor' :: SomeColor -> Color'
+someToColor' = toColor' . someToAlpha
+
+
+-- | QuasiQuoter which reads in a hex color code and outputs a 'AlphaColour Double'.
 hex :: QuasiQuoter
 hex = QuasiQuoter
-    { quoteExp = readHexColor >=> \x -> x `seq` pure [|x|]
+    { quoteExp = readHexColor >=> pure . toColor' >=> \x -> x `seq` [|x|]
     , quotePat = failure "quotePat"
     , quoteType = failure "quoteType"
     , quoteDec = failure "quoteDec"