MonadTransConfigEx.hs

#!/usr/bin/env stack
-- stack runghc --resolver lts-9.14 --install-ghc --package mtl

{-# LANGUAGE CPP #-}

import Control.Monad.Trans.Maybe  (MaybeT(MaybeT), runMaybeT)
import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)
import System.Environment         (lookupEnv)



data Config = Config
  { env         :: Env
  , port        :: Port
  , databaseUrl :: String
  } deriving ( Show )

type Port = Int

data Env = Dev | Test | Prod
  deriving ( Read, Show )



buildConfig :: IO (Maybe Config)
buildConfig = do
  mEnv   <- fmap read <$> lookupEnv "ENV"
  mPort  <- fmap read <$> lookupEnv "PORT"
  mDbUrl <- lookupEnv "DATABASE_URL"

  -- -- Option #1 -- `case` statement
  -- case (mEnv, mPort, mDbUrl) of
  --   (Just env, Just port, Just dbUrl) ->
  --     return $ Just $ Config env port dbUrl
  --   _ ->
  --     return Nothing

  -- -- Option #2 -- `do` block
  -- return $ do
  --   env   <- mEnv
  --   port  <- mPort
  --   dbUrl <- mDbUrl
  --
  --   -- Just $ Config env port dbUrl
  --   return $ Config env port dbUrl

  -- Option #3 -- Applicative
  return $ Config <$> mEnv <*> mPort <*> mDbUrl



buildConfig' :: IO (Maybe Config)
buildConfig' = runMaybeT $ do
  env   <- MaybeT $ fmap read <$> lookupEnv "ENV"
  port  <- MaybeT $ fmap read <$> lookupEnv "PORT"
  dbUrl <- MaybeT $ lookupEnv "DATABASE_URL"

  return $ Config env port dbUrl



lookupEnv' :: String -> MaybeT IO String
lookupEnv' = MaybeT . lookupEnv

readEnv :: ( Read a ) => String -> IO (Maybe a)
readEnv = (fmap . fmap) read . lookupEnv

readEnv' :: ( Read a ) => String -> MaybeT IO a
readEnv' = MaybeT . readEnv

readEnv'' :: ( Read a ) => String -> MaybeT IO a
readEnv'' = fmap read . lookupEnv'



buildConfig'' :: IO (Maybe Config)
buildConfig'' = runMaybeT $ do
  env   <- readEnv'   "ENV"
  port  <- readEnv''  "PORT"
  dbUrl <- lookupEnv' "DATABASE_URL"

  return $ Config env port dbUrl



buildConfig''' :: IO (Maybe Config)
buildConfig''' = runMaybeT $ do
  Config
    <$> (readEnv' "ENV")
    <*> (readEnv'' "PORT")
    <*> (lookupEnv' "DATABASE_URL")



buildConfig'''' :: MaybeT IO Config
buildConfig'''' = do
  Config
    <$> (readEnv' "ENV")
    <*> (readEnv'' "PORT")
    <*> (lookupEnv' "DATABASE_URL")



main :: IO ()
main = do
  print =<< buildConfig
  print =<< buildConfig'
  print =<< buildConfig''
  print =<< buildConfig'''
  print =<< runMaybeT buildConfig''''