{-# LANGUAGE RankNTypes #-}
-- | Different utilities

module OrgStat.Util
       ( dropLowerOptions
       , dropEnd
       , addLocalTime
       , fromJustM
       , parseColour
       , hashColour
       , (??~)
       , timeF
       ) where

import Control.Lens (ASetter, ix)
import Data.Aeson.TH (defaultOptions)
import Data.Aeson.Types (Options, fieldLabelModifier)
import Data.Char (isLower, toLower)
import Data.Colour (Colour)
import Data.Colour.CIE (luminance)
import Data.Colour.SRGB (RGB(..), sRGB24, toSRGBBounded)
import Data.List (nub)
import Data.List ((!!))
import Data.Time (LocalTime(..), NominalDiffTime, addUTCTime, localTimeToUTC, utc, utcToLocalTime)
import Universum

-- | JSON/Yaml TH modifier. Each field of type "aoeuKek" turns into
-- "kek". Placed here because it can't be defined near json TH
  deriving ( ghc restriction ) .
dropLowerOptions :: Options
dropLowerOptions =
    defaultOptions
    { fieldLabelModifier = \x -> (dropWhile isLower x) & ix 0 %~ toLower
    }

fromJustM :: Monad m => m b -> m (Maybe b) -> m b
fromJustM e m = maybe e pure =<< m

-- | Drops n items from the end.
dropEnd :: Int -> [x] -> [x]
dropEnd n xs = take (length xs - n) xs

-- | Same as 'addUTCTime', but for local
addLocalTime :: (Integral n) => n -> LocalTime -> LocalTime
addLocalTime n a =
    utcToLocalTime utc $ fromIntegral n `addUTCTime` localTimeToUTC utc a

-- | Parses colour from format '#rrggbb' or just 'rrggbb'
parseColour :: forall s a. (ToString s, Floating a, Ord a) => s -> Maybe (Colour a)
parseColour (toString -> s) = toColour $ dropWhile (== '#') s
  where
    toColour [r1,r2,g1,g2,b1,b2] = do
        r <- toWord8 r1 r2
        g <- toWord8 g1 g2
        b <- toWord8 b1 b2
        pure $ sRGB24 r g b
    toColour _                   = Nothing
    toWord8 a b = readMaybe $ "0x"++[a,b]

-- | Generates a colour given salt and anything hashable. Doesn't return
-- too dark or too light colors.
hashColour :: (Hashable a) => Int -> a -> Colour Double
hashColour salt item = colours !! (hashWithSalt salt item `mod` length colours)
  where
    broken = error "Util#hashColour is broken"
    range = [-5,0,5]
    colours = filter (\c -> luminance c < 0.8 && luminance c > 0.06) mutate
    ac :: Word8 -> Integer -> Word8
    ac a b = fromIntegral $ (fromIntegral a) + b `mod` 255
    mutate = nub $ concatMap
        (\(r,g,b) -> [sRGB24 (r `ac` i) (g `ac` j) (b `ac` k)
                     | i <- range, j <- range, k <- range])
        coloursBasic
    coloursBasic =
        map (toTriple . fromMaybe broken . parseColour @[Char] @Double) popularColours
    toTriple c = let RGB{..} = toSRGBBounded c in (channelRed, channelGreen, channelBlue)
    popularColours :: [[Char]]
    popularColours = ["00FF00","01FFFE","FFA6FE","FFDB66","006401","010067","95003A","007DB5","FF00F6","FFEEE8","774D00","90FB92","0076FF","D5FF00","FF937E","6A826C","FF029D","FE8900","7A4782","7E2DD2","85A900","FF0056","A42400","00AE7E","683D3B","BDC6FF","263400","BDD393","00B917","9E008E","001544","C28C9F","FF74A3","01D0FF","004754","E56FFE","788231","0E4CA1","91D0CB","BE9970","968AE8","BB8800","43002C","DEFF74","00FFC6","FFE502","620E00","008F9C","98FF52","7544B1","B500FF","00FF78","FF6E41","005F39","6B6882","5FAD4E","A75740","A5FFD2","FFB167","009BFF","E85EBE"];

-- | Maybe setter that does nothing on Nothing.
(??~) :: ASetter s s a b -> Maybe b -> s -> s
(??~) _ Nothing  = id
(??~) l (Just k) = l .~ k

  | Time formatter in form HH : MM
timeF :: NominalDiffTime -> Text
timeF n = do
    let totalTimeMin :: Integer
        totalTimeMin = round $ (/ 60) $ toRational n
    let hours = totalTimeMin `div` 60
    let minutes = totalTimeMin `mod` 60
    let showTwo x = (if x < 10 then "0" else "") <> show x
    fromString $ show hours <> ":" <> showTwo minutes

# LANGUAGE RankNTypes #
 | Different utilities
 | JSON/Yaml TH modifier. Each field of type "aoeuKek" turns into
 "kek". Placed here because it can't be defined near json TH
 | Drops n items from the end.
 | Same as 'addUTCTime', but for local
 | Parses colour from format '#rrggbb' or just 'rrggbb'
 | Generates a colour given salt and anything hashable. Doesn't return
 too dark or too light colors.
 | Maybe setter that does nothing on Nothing.

module OrgStat.Util
       ( dropLowerOptions
       , dropEnd
       , addLocalTime
       , fromJustM
       , parseColour
       , hashColour
       , (??~)
       , timeF
       ) where

import Control.Lens (ASetter, ix)
import Data.Aeson.TH (defaultOptions)
import Data.Aeson.Types (Options, fieldLabelModifier)
import Data.Char (isLower, toLower)
import Data.Colour (Colour)
import Data.Colour.CIE (luminance)
import Data.Colour.SRGB (RGB(..), sRGB24, toSRGBBounded)
import Data.List (nub)
import Data.List ((!!))
import Data.Time (LocalTime(..), NominalDiffTime, addUTCTime, localTimeToUTC, utc, utcToLocalTime)
import Universum

  deriving ( ghc restriction ) .
dropLowerOptions :: Options
dropLowerOptions =
    defaultOptions
    { fieldLabelModifier = \x -> (dropWhile isLower x) & ix 0 %~ toLower
    }

fromJustM :: Monad m => m b -> m (Maybe b) -> m b
fromJustM e m = maybe e pure =<< m

dropEnd :: Int -> [x] -> [x]
dropEnd n xs = take (length xs - n) xs

addLocalTime :: (Integral n) => n -> LocalTime -> LocalTime
addLocalTime n a =
    utcToLocalTime utc $ fromIntegral n `addUTCTime` localTimeToUTC utc a

parseColour :: forall s a. (ToString s, Floating a, Ord a) => s -> Maybe (Colour a)
parseColour (toString -> s) = toColour $ dropWhile (== '#') s
  where
    toColour [r1,r2,g1,g2,b1,b2] = do
        r <- toWord8 r1 r2
        g <- toWord8 g1 g2
        b <- toWord8 b1 b2
        pure $ sRGB24 r g b
    toColour _                   = Nothing
    toWord8 a b = readMaybe $ "0x"++[a,b]

hashColour :: (Hashable a) => Int -> a -> Colour Double
hashColour salt item = colours !! (hashWithSalt salt item `mod` length colours)
  where
    broken = error "Util#hashColour is broken"
    range = [-5,0,5]
    colours = filter (\c -> luminance c < 0.8 && luminance c > 0.06) mutate
    ac :: Word8 -> Integer -> Word8
    ac a b = fromIntegral $ (fromIntegral a) + b `mod` 255
    mutate = nub $ concatMap
        (\(r,g,b) -> [sRGB24 (r `ac` i) (g `ac` j) (b `ac` k)
                     | i <- range, j <- range, k <- range])
        coloursBasic
    coloursBasic =
        map (toTriple . fromMaybe broken . parseColour @[Char] @Double) popularColours
    toTriple c = let RGB{..} = toSRGBBounded c in (channelRed, channelGreen, channelBlue)
    popularColours :: [[Char]]
    popularColours = ["00FF00","01FFFE","FFA6FE","FFDB66","006401","010067","95003A","007DB5","FF00F6","FFEEE8","774D00","90FB92","0076FF","D5FF00","FF937E","6A826C","FF029D","FE8900","7A4782","7E2DD2","85A900","FF0056","A42400","00AE7E","683D3B","BDC6FF","263400","BDD393","00B917","9E008E","001544","C28C9F","FF74A3","01D0FF","004754","E56FFE","788231","0E4CA1","91D0CB","BE9970","968AE8","BB8800","43002C","DEFF74","00FFC6","FFE502","620E00","008F9C","98FF52","7544B1","B500FF","00FF78","FF6E41","005F39","6B6882","5FAD4E","A75740","A5FFD2","FFB167","009BFF","E85EBE"];

(??~) :: ASetter s s a b -> Maybe b -> s -> s
(??~) _ Nothing  = id
(??~) l (Just k) = l .~ k

  | Time formatter in form HH : MM
timeF :: NominalDiffTime -> Text
timeF n = do
    let totalTimeMin :: Integer
        totalTimeMin = round $ (/ 60) $ toRational n
    let hours = totalTimeMin `div` 60
    let minutes = totalTimeMin `mod` 60
    let showTwo x = (if x < 10 then "0" else "") <> show x
    fromString $ show hours <> ":" <> showTwo minutes
