{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Data.H3.Colour(
ordinalColours,
OrdinalColours,
Colour,
PaletteType(..),
paletteFor,
toCSSColour
) where
import Data.Colour.Names (black)
import Data.Colour.Palette.BrewerSet (ColorCat (..), brewerSet)
import Data.Colour.RGBSpace (Colour)
import Data.Colour.SRGB (sRGB24show)
import Data.Functor.Identity (Identity (..))
import Data.H3.Scalable
import qualified Data.Map as Map
import GHC.Generics (Generic)
data OrdinalColours a
ordinalColours :: [a] -> ScaleOptions OrdinalColours a (Colour Double)
ordinalColours = flip OrdColourScaleOptions black
instance (Ord a, Eq a) => Scalable OrdinalColours a (Colour Double) where
type Target OrdinalColours = Identity
type TargetRange OrdinalColours (Colour Double) = ()
data ScaleOptions OrdinalColours a (Colour Double) =
OrdColourScaleOptions
[a]
(Colour Double)
scale (OrdColourScaleOptions ex k) _ = scMap where
n = length ex
pl = paletteFor Qualitative n
theMap = Map.fromList
$ zip ex
$ cycle pl
scMap av = Identity $ Map.findWithDefault k av theMap
data PaletteType =
Sequential
| Diverging
| Qualitative
deriving (Eq, Ord, Show, Generic)
paletteFor :: PaletteType -> Int -> [Colour Double]
paletteFor pt i = brewerSet cat i' where
(cat, i') = case pt of
Sequential -> (Greens, clamp (3, 9) i)
Diverging -> (PiYG, clamp (3, 11) i)
Qualitative -> (Dark2, clamp (3, 8) i)
clamp (mn, mx) n = max mn (min mx n)
toCSSColour :: Colour Double -> String
toCSSColour = sRGB24show