From c9cc52175073c5e690ea7eb30aad23d0d1776435 Mon Sep 17 00:00:00 2001
From: Chris Wells <chris@mathematicaster.org>
Date: Wed, 4 Dec 2024 13:23:40 -0600
Subject: Trying to write css

---
 src/WWW/Colors/QQ.hs | 31 +++++++++++++++++++++++++++----
 1 file changed, 27 insertions(+), 4 deletions(-)

(limited to 'src/WWW/Colors/QQ.hs')

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"
-- 
cgit v1.2.3