module OrgStat.Util
( dropLowerOptions
, dropEnd
, addLocalTime
, fromJustM
, parseColour
, hashColour
, (??~)
) 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.Hashable (hashWithSalt)
import Data.List (nub)
import Data.List ((!!))
import Data.Time (LocalTime (..), addUTCTime, localTimeToUTC, utc,
utcToLocalTime)
import Universum
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 = identity
(??~) l (Just k) = l .~ k