-- | Reasonable conventions for embedding YAML configuration with Template Haskell
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.Yaml.Config.Embed
  ( module Data.Yaml.Config.Embed
  , AesonKebab(..)
  )
  where

import Control.Exception (throwIO)
import Data.Aeson (FromJSON, Value)
import Data.ByteString (ByteString)
import Data.FileEmbed (embedFile, makeRelativeToProject)
import Data.Yaml.Config.Kebab (AesonKebab(..))
import Language.Haskell.TH.Syntax (Exp, Q)

import qualified Data.Yaml as Yaml
import qualified Data.Yaml.Config as Yaml.Config

-- | TH function for loading @config/settings.yml@ relative to
-- the project in which the TH splice is written.
--
-- > loadConfig :: IO MyConfig
-- > loadConfig = $(embedConfig)
embedConfig :: Q Exp
embedConfig :: Q Exp
embedConfig = FilePath -> Q Exp
embedConfigRelativeToProject FilePath
"config/settings.yml"

-- | TH function for loading the supplied config file path
-- relative to the project in which the TH splice is written.
--
-- > loadConfig :: IO MyConfig
-- > loadConfig = $(embedConfigRelativeToProject "path/to/settings.yml")
embedConfigRelativeToProject :: FilePath -> Q Exp
embedConfigRelativeToProject :: FilePath -> Q Exp
embedConfigRelativeToProject FilePath
relPath = do
  FilePath
absPath <- FilePath -> Q FilePath
makeRelativeToProject FilePath
relPath
  [| loadFromBytes $(embedFile absPath) |]

-- | Given the file content, read a YAML config file.
loadFromBytes :: (FromJSON a) => ByteString -> IO a
loadFromBytes :: ByteString -> IO a
loadFromBytes ByteString
bytes = do
  Value
yaml <- (ParseException -> IO Value)
-> (Value -> IO Value) -> Either ParseException Value -> IO Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseException -> IO Value
forall e a. Exception e => e -> IO a
throwIO Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseException Value -> IO Value)
-> Either ParseException Value -> IO Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseException Value
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' ByteString
bytes
  Value -> IO a
forall a. FromJSON a => Value -> IO a
loadFromValue Value
yaml

-- | Given the file content as an Aeson 'Value', read a YAML config file.
loadFromValue :: (FromJSON a) => Value -> IO a
loadFromValue :: Value -> IO a
loadFromValue Value
yaml = do
  [FilePath] -> [Value] -> EnvUsage -> IO a
forall settings.
FromJSON settings =>
[FilePath] -> [Value] -> EnvUsage -> IO settings
Yaml.Config.loadYamlSettings [] [Value
yaml] EnvUsage
Yaml.Config.useEnv