Color.hs

{-|
This module exposes a way to load the colorscheme at runtime as opposed to
compile-time for the purposes of (meaningful) compatibility with (py)wal.
-}

module Color (Colorscheme (..), HexColor, getColorscheme, hideous) where

import           Control.Exception              (catch)
import           Data.Aeson                     (FromJSON, decode)
import           System.Environment.XDG.BaseDir (getUserCacheFile)

type HexColor = String

newtype Theme = Theme
  { colors :: Colorscheme
  }
  deriving (Generic, FromJSON)

data Colorscheme = Colorscheme
  { color0  :: HexColor
  , color1  :: HexColor
  , color2  :: HexColor
  , color3  :: HexColor
  , color4  :: HexColor
  , color5  :: HexColor
  , color6  :: HexColor
  , color7  :: HexColor
  , color8  :: HexColor
  , color9  :: HexColor
  , color10 :: HexColor
  , color11 :: HexColor
  , color12 :: HexColor
  , color13 :: HexColor
  , color14 :: HexColor
  , color15 :: HexColor
  }
  deriving (Generic, FromJSON)

-- From: https://hackage.haskell.org/package/ghc-8.10.2/docs/Maybes.html#v:tryMaybeT
tryMaybeT :: IO a -> MaybeT IO a
tryMaybeT f = MaybeT $ catch (Just <$> f) handler
  where handler (SomeException _) = pure Nothing

safeReadFileLBS :: FilePath -> MaybeT IO LByteString
safeReadFileLBS = tryMaybeT . readFileLBS

getColorschemePath :: MaybeT IO FilePath
getColorschemePath = tryMaybeT $ getUserCacheFile "wal" "colors.json"

-- | Attempts to get the colorscheme generated by (py)wal.
getColorscheme :: IO (Maybe Colorscheme)
getColorscheme = runMaybeT $ do
  x <- safeReadFileLBS =<< getColorschemePath
  MaybeT . pure . fmap colors . decode $ x

-- | A hideous color that can be used as a fallback to make failure obvious
-- without bringing the system down.
hideous :: HexColor
hideous = "#00FF00"