-- |
-- Copyright: (c) 2019 Lucas David Traverso
-- License: MPL-2.0
-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>
-- Stability: stable
-- Portability: portable
--
-- Source for json config files using Aeson
module Conferer.Source.Yaml where

import Data.Yaml

import qualified Conferer.Source.Aeson as JSON
import Conferer.Source.Files
import Conferer.Source

-- | Create a 'SourceCreator' from a yaml file that we get from the env
-- with the same logic as 'JSON.JSONSource'
fromConfig :: Key -> SourceCreator
fromConfig :: Key -> SourceCreator
fromConfig Key
key Config
config = do
  FilePath
filePath <- Key -> FilePath -> Config -> IO FilePath
getFilePathFromEnv Key
key FilePath
"yaml" Config
config
  FilePath -> IO Source
fromFilePath' FilePath
filePath

-- | Create a 'SourceCreator' by reading the provided path as json
fromFilePath :: FilePath -> SourceCreator
fromFilePath :: FilePath -> SourceCreator
fromFilePath FilePath
filePath Config
_config =
  FilePath -> IO Source
fromFilePath' FilePath
filePath

-- | Create a 'Source' by reading the provided path as json 
fromFilePath' :: FilePath -> IO Source
fromFilePath' :: FilePath -> IO Source
fromFilePath' FilePath
filePath = do
  Either ParseException Value
configAsJson <- FilePath -> IO (Either ParseException Value)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither FilePath
filePath
  case Either ParseException Value
configAsJson of
    Right Value
jsonConfig -> Source -> IO Source
forall (m :: * -> *) a. Monad m => a -> m a
return (Source -> IO Source) -> Source -> IO Source
forall a b. (a -> b) -> a -> b
$ Value -> Source
JSON.fromValue Value
jsonConfig
    Left ParseException
parseException -> FilePath -> IO Source
forall a. HasCallStack => FilePath -> a
error (ParseException -> FilePath
forall a. Show a => a -> FilePath
show ParseException
parseException)