-- |
-- Copyright: (c) 2019 Lucas David Traverso
-- License: MPL-2.0
-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>
-- Stability: stable
-- Portability: portable
--
-- Public API module providing some helper functions related to files
{-# LANGUAGE TypeApplications #-}
module Conferer.Source.Files where

import Data.Maybe (fromMaybe)
import System.FilePath

import Conferer.Config
import Conferer.FromConfig

-- | Helper function to get a file from the config specifying the extension and using
-- current env
getFilePathFromEnv :: Key -> String -> Config -> IO FilePath
getFilePathFromEnv :: Key -> String -> Config -> IO String
getFilePathFromEnv Key
key String
extension Config
config = do
  String
env <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"development" (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Config -> IO (Maybe String)
forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a
fetchFromConfig @(Maybe String) Key
"env" Config
config
  let defaultPath :: String
defaultPath = String
"config" String -> String -> String
</> String
env String -> String -> String
<.> String
extension
  File String
filepath <- Config -> Key -> File -> IO File
forall a. (Typeable a, FromConfig a) => Config -> Key -> a -> IO a
fetchFromConfigWithDefault @File Config
config Key
key (File -> IO File) -> File -> IO File
forall a b. (a -> b) -> a -> b
$ String -> File
File String
defaultPath
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
filepath