{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}

module WebColor where

import           Data.Aeson
import           Data.Data
import           Data.String
import qualified Data.Text                    as T
import           Data.Word
import           GHC.Generics
import           Numeric
import           System.Random
import           Text.ParserCombinators.ReadP
import           Text.Read                    (readEither)

data RGBColor
    = RGBColor
        { rgbRed   :: {-# UNPACK #-} !Word8
        , rgbGreen :: {-# UNPACK #-} !Word8
        , rgbBlue  :: {-# UNPACK #-} !Word8
        }
    deriving (Eq, Ord, Bounded, Data, Typeable, Generic)

instance Show RGBColor where
    showsPrec _ RGBColor{..} = \s -> "#" ++ rr ++ rg ++ rb ++ s
        where rr = pad $ showHex rgbRed ""
              rg = pad $ showHex rgbGreen ""
              rb = pad $ showHex rgbBlue ""
              pad [x] = '0' : [x]
              pad  x  = x

instance Read RGBColor where
    readsPrec _ = readP_to_S $ do
        c <- get
        if c /= '#'
            then pfail
            else do (r1, r2) <- (,) <$> get <*> get
                    (g1, g2) <- (,) <$> get <*> get
                    (b1, b2) <- (,) <$> get <*> get
                    let [(r,_)] = readHex [r1, r2]
                        [(g,_)] = readHex [g1, g2]
                        [(b,_)] = readHex [b1, b2]
                    return $ RGBColor r g b

instance ToJSON RGBColor where
    toJSON = String . T.pack . show

instance FromJSON RGBColor where
    parseJSON = withText "RGBColor" $ return . read . T.unpack

instance Random RGBColor where
    randomR (RGBColor lr lg lb, RGBColor hr hg hb) gen =
        let (r, gen1) = randomR (lr, hr) gen
            (g, gen2) = randomR (lg, hg) gen1
            (b, gen3) = randomR (lb, hb) gen2
         in (RGBColor r g b, gen3)
    random gen = let (r, gen1) = random gen
                     (g, gen2) = random gen1
                     (b, gen3) = random gen2
                  in (RGBColor r g b, gen3)

instance IsString RGBColor where
    fromString = read
