module RFC.Env
( isDevelopment
, readEnvironment
, readHost
, readPort
, readAppSlug
, forDevOnly
, envWithDefault
, envWithDevDefault
, module System.Envy
) where
import Control.Applicative
import Data.Time.Clock
import Data.Word
import Network (PortID (..))
import RFC.Prelude
import System.Environment
import System.Envy
import Text.Read (readMaybe)
envWithDefault :: Var a => String -> a -> Parser a
envWithDefault name defaultValue = fmap (fromMaybe defaultValue) $ envMaybe name
envWithDevDefault :: Var a => String -> a -> Parser a
envWithDevDefault name defaultValue =
if isDevelopment then
envWithDefault name defaultValue
else
env name
isDevelopment :: Bool
isDevelopment =
#ifdef DEVELOPMENT
True
#else
False
#endif
forDevOnly :: a -> Maybe a
forDevOnly defaultValue =
if isDevelopment then
Just defaultValue
else
Nothing
readEnvironment :: (MonadIO m) => m String
readEnvironment =
readEnvWithDefault "ENV" "development"
readAppSlug :: (MonadIO m, MonadFail m) => m String
readAppSlug = readEnvWithDevDefault "APP_SLUG" "dev"
readHost :: (MonadIO m, MonadFail m) => m String
readHost =
readEnvWithDevDefault "HOST" "localhost"
readPort :: (MonadIO m, MonadFail m) => Word16 -> m Word16
readPort devPort = readEnvWithDevDefault "PORT" devPort
readEnvWithDefault :: (MonadIO m, Read a) => String -> a -> m a
readEnvWithDefault name defaultValue =
either (const defaultValue) id <$> readEnv name
readEnvWithDevDefault :: (MonadIO m, MonadFail m, Read a) => String -> a -> m a
readEnvWithDevDefault =
if isDevelopment then
readEnvWithDefault
else
(\name _ -> readEnvOrDie name)
readEnv :: (MonadIO m, Read a) => String -> m (Either String a)
readEnv name = liftIO $ do
result <- lookupEnv name
return $ case result >>= readMaybe of
Nothing -> Left (show result)
Just goodValue -> Right goodValue
readEnvOrDie :: (MonadIO m, MonadFail m, Read a) => String -> m a
readEnvOrDie name = do
maybeResult <- readEnv name
case maybeResult of
Left err ->
if err == (show (Nothing::Maybe String)) then
fail $ "No value set for mandatory environment variable: " ++ name
else
fail $ "Cannot use value set for mandatory environment variable: " ++ name ++ " => " ++ err
Right result -> return result
instance Var NominalDiffTime where
toVar :: NominalDiffTime -> String
toVar = show
fromVar :: String -> Maybe NominalDiffTime
fromVar var = fromInteger <$> readMaybe var
instance Var PortID where
toVar (PortNumber portNum) = toVar $ toInteger portNum
toVar _ = error "Can only write port numbers to var"
fromVar = (fmap $ PortNumber . fromInteger) . fromVar