-- |
-- 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
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Conferer.FromConfig.Aeson where

import Data.Aeson

import Conferer.FromConfig
import Data.Text (Text)
import qualified Data.Text.Encoding as Text

instance FromConfig Value where
  fetchFromConfig :: Key -> Config -> IO Value
fetchFromConfig Key
key Config
config = do
    Text
rawAeson <- Key -> Config -> IO Text
forall a. FromConfig a => Key -> Config -> IO a
fetchFromConfig @Text Key
key Config
config
    case FromJSON Value => ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' @Value (ByteString -> Either String Value)
-> ByteString -> Either String Value
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
rawAeson of
      Right Value
value -> 
        Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
value
      Left String
_ -> 
        Key -> Text -> IO Value
forall a b. Typeable a => Key -> Text -> IO b
throwConfigParsingError @Value Key
key Text
rawAeson