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

import qualified Data.Text.IO as Text
import Dhall
import Dhall.JSON
import System.Directory (doesFileExist)
import Conferer.Source.Files
import qualified Conferer.Source.Aeson as JSON
import qualified Conferer.Source.Null as Null

import Conferer.Source
import Control.Exception

-- | Create a 'SourceCreator' from a dhall config file
-- using 'fromFilePath'
fromConfig :: Key -> SourceCreator
fromConfig :: Key -> SourceCreator
fromConfig Key
key Config
config = do
  FilePath
filePath <- Key -> FilePath -> Config -> IO FilePath
getFilePathFromEnv Key
key FilePath
"dhall" Config
config
  FilePath -> IO Source
fromFilePath' FilePath
filePath


-- | Create a 'SourceCreator' from a filepath reading it as dhall
-- if the file doesn't exist do nothing, but if it has invalid
-- dhall throw an exception.
fromFilePath :: FilePath -> SourceCreator
fromFilePath :: FilePath -> SourceCreator
fromFilePath FilePath
filePath Config
_config =
  FilePath -> IO Source
fromFilePath' FilePath
filePath

-- | Create a 'Source' from a filepath reading it as dhall
-- if the file doesn't exist do nothing, but if it has invalid
-- dhall throw an exception.
fromFilePath' :: FilePath -> IO Source
fromFilePath' :: FilePath -> IO Source
fromFilePath' FilePath
filePath = do
  Bool
fileExists <- FilePath -> IO Bool
doesFileExist FilePath
filePath
  if Bool
fileExists
    then do
      Text
fileContent <- FilePath -> IO Text
Text.readFile FilePath
filePath
      Expr Src Void
dhallExpr <- Text -> IO (Expr Src Void)
inputExpr Text
fileContent
      case Expr Src Void -> Either CompileError Value
forall s. Expr s Void -> Either CompileError Value
dhallToJSON Expr Src Void
dhallExpr of
        Right Value
jsonConfig -> do
          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 CompileError
compileError ->
          ErrorCall -> IO Source
forall e a. Exception e => e -> IO a
throwIO (ErrorCall -> IO Source) -> ErrorCall -> IO Source
forall a b. (a -> b) -> a -> b
$ FilePath -> ErrorCall
ErrorCall (CompileError -> FilePath
forall a. Show a => a -> FilePath
show CompileError
compileError)
    else do
      Source -> IO Source
forall (m :: * -> *) a. Monad m => a -> m a
return Source
Null.empty