HTMLColourCode.hs

{-
	Copyright (C) 2015 Dr. Alistair Ward

	This file is part of WeekDaze.

	WeekDaze is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	WeekDaze is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with WeekDaze.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@] Exports some colour-manipulation functions for HTML.
-}

module WeekDaze.Colour.HTMLColourCode(
-- * Types
-- ** Type-synonyms
	HTMLColourCode,
-- * Constants
--	htmlColourCodeHexDigits,
	htmlColourCodePrefix,
-- * Functions
	deriveComplementaryHTMLColourCode,
	generateHTMLColourCodeFrom,
--	hash,
	readHex
) where

import qualified	Crypto.Hash
import qualified	Data.Bits
import			Data.Bits((.&.))
import qualified	Data.ByteString.Char8
import qualified	Numeric
import qualified	Text.Printf

-- | The representation in HTML of 24-bit colour.
type HTMLColourCode	= String

-- | The number of hex-digits required to represent 24-bit colour in HTML.
htmlColourCodeHexDigits :: Int
htmlColourCodeHexDigits	= 6

-- | The prefix used when specifying an HTML colour-code.
htmlColourCodePrefix :: Char
htmlColourCodePrefix	= '#'

-- | Hash the specified string.
hash :: String -> String
hash	= (show :: Crypto.Hash.Digest Crypto.Hash.MD5 {-arbitrarily-} -> String) . Crypto.Hash.hash . Data.ByteString.Char8.pack

-- | Generate an arbitrary HTML colour-code using a hash of the specified string.
generateHTMLColourCodeFrom :: String -> HTMLColourCode
generateHTMLColourCodeFrom	= (htmlColourCodePrefix :) . take htmlColourCodeHexDigits . hash

-- | Interpret the specified string as hexadecimal.
readHex :: (Eq i, Num i) => String -> i
readHex s	= case Numeric.readHex s of
	[(hex, [])]	-> hex
	_		-> error $ "WeekDaze.Colour.HTMLColourCode.readHex:\tfailed to interpret '" ++ s ++ "' as hexadecimal."

-- | Return the complement of the specified HTML colour-code.
deriveComplementaryHTMLColourCode :: HTMLColourCode -> HTMLColourCode
deriveComplementaryHTMLColourCode htmlColourCode	= Text.Printf.printf (htmlColourCodePrefix : "%0*x") htmlColourCodeHexDigits $ bitMask .&. Data.Bits.complement (readHex $ tail htmlColourCode) where
	bitMask :: Int
	bitMask	= 0xffffff	-- 24-bit colour.