-- |
-- Module      : AOC.Run.Config
-- Copyright   : (c) Justin Le 2018
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Utilities for loading configuration file.
--


module AOC.Run.Config (
    Config(..), configFile, defConfPath
  , session
  ) where

import           Control.Exception
import           Control.Monad
import           Data.Default.Class
import           GHC.Generics      (Generic)
import           System.IO.Error
import           Text.Printf
import qualified Data.Aeson        as A
import qualified Data.ByteString   as BS
import qualified Data.Yaml         as Y


-- | Configuration for auto-runner.
data Config = Cfg
    { Config -> Maybe FilePath
_cfgSession :: Maybe String     -- ^ Default: 'Nothing'
    , Config -> Integer
_cfgYear    :: Integer          -- ^ Default: 2015
    }
  deriving ((forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generic)

-- | No session key, and 2015.
instance Default Config where
    def :: Config
def = Cfg :: Maybe FilePath -> Integer -> Config
Cfg { _cfgSession :: Maybe FilePath
_cfgSession = Maybe FilePath
forall a. Maybe a
Nothing
              , _cfgYear :: Integer
_cfgYear    = Integer
2015
              }

-- | Default math to find a configuration file.
defConfPath :: FilePath
defConfPath :: FilePath
defConfPath = FilePath
"aoc-conf.yaml"

-- | Load a 'Config' from a given filepath.
configFile :: FilePath -> IO Config
configFile :: FilePath -> IO Config
configFile FilePath
fp = do
    Either () ByteString
cfgInp <- (IOError -> Maybe ()) -> IO ByteString -> IO (Either () ByteString)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError)
            (IO ByteString -> IO (Either () ByteString))
-> IO ByteString -> IO (Either () ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BS.readFile FilePath
fp
    case Either () ByteString
cfgInp of
      Left () -> do
        forall a. ToJSON a => FilePath -> a -> IO ()
Y.encodeFile @Config FilePath
fp Config
forall a. Default a => a
def
        return Config
forall a. Default a => a
def
      Right ByteString
b ->
        case ByteString -> Either ParseException Config
forall a. FromJSON a => ByteString -> Either ParseException a
Y.decodeEither' ByteString
b of
          Left ParseException
e -> do
            FilePath -> FilePath -> IO ()
forall r. PrintfType r => FilePath -> r
printf FilePath
"Configuration file at %s could not be parsed:\n" FilePath
fp
            ParseException -> IO ()
forall a. Show a => a -> IO ()
print ParseException
e
            return Config
forall a. Default a => a
def
          Right Config
cfg -> Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
cfg

-- | Load a session token from the configuration file at a given filepath.
session :: FilePath -> IO (Maybe String)
session :: FilePath -> IO (Maybe FilePath)
session = (Config -> Maybe FilePath) -> IO Config -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Config -> Maybe FilePath
_cfgSession (IO Config -> IO (Maybe FilePath))
-> (FilePath -> IO Config) -> FilePath -> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Config
configFile

configJSON :: A.Options
configJSON :: Options
configJSON = Options
A.defaultOptions
    { fieldLabelModifier :: FilePath -> FilePath
A.fieldLabelModifier = Char -> FilePath -> FilePath
A.camelTo2 Char
'-' (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
4 }

instance A.ToJSON Config where
    toJSON :: Config -> Value
toJSON     = Options -> Config -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON Options
configJSON
    toEncoding :: Config -> Encoding
toEncoding = Options -> Config -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding Options
configJSON
instance A.FromJSON Config where
    parseJSON :: Value -> Parser Config
parseJSON  = Options -> Value -> Parser Config
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON Options
configJSON