EnvVars.hs

module EnvParse where

import Control.Lens         (from, view, (^.), over, _Left)
import System.IO (stderr, hPutStrLn, hPrint)
import Control.Monad        ((<=<))
import Control.Monad.Reader (ReaderT (..), runReaderT)
import Data.Validation      (AccValidation, _AccValidation, _Either)
import System.Environment   (getEnvironment)
import System.Exit          (exitFailure)
import Text.Read            (readEither)

data EnvError = NoKey String
              | ParseError String String
                deriving (Eq, Show)

type EnvVars = [(String, String)]

type EnvA a = ReaderT EnvVars (AccValidation [EnvError]) a

-- ENV variable 'parsers'

readEnv :: Read b
        => String -> EnvA b
readEnv = parseEnv readEither

strEnv :: String -> EnvA String
strEnv = parseEnv pure

parseEnv :: (String -> Either String b) -> String -> EnvA b
parseEnv parser k =
  ReaderT $
  \env ->
    (fromEnv k env >>=
     readWith parser k) ^.
    from _Either

-- Execute parsers

runEnvA :: EnvA a -> EnvVars -> Either [EnvError] a
runEnvA ea =
  view (from _AccValidation) .
  runReaderT ea

runEnvIO :: EnvA a -> IO (Either [EnvError] a)
runEnvIO x = runEnvA x `fmap` getEnvironment

runEnvIOE :: EnvA a -> IO a
runEnvIOE = handleErrors <=< runEnvIO
  where handleErrors :: Either [EnvError] a -> IO a
        handleErrors (Left es) =
          do hPutStrLn stderr "Failed to parse from ENV: "
             mapM_ (hPrint stderr) es
             exitFailure
        handleErrors (Right x) = return x


-- Internals

fromEnv :: String -> EnvVars -> Either [EnvError] String
fromEnv k = maybeToEither (return . NoKey $ k) . lookup k

readWith :: Applicative m => (String -> Either String b) -> String -> String -> Either (m EnvError) b
readWith f k v = over _Left toError . f $ v
  where toError =
          pure .
          ParseError k .
          ((v ++ " - ") ++)

maybeToEither :: b -> Maybe a -> Either b a
maybeToEither = flip maybe Right . Left