module System.Envy
(
FromEnv (..)
, ToEnv (..)
, Var (..)
, EnvList
, decodeEnv
, decode
, showEnv
, setEnvironment
, unsetEnvironment
, makeEnv
, env
, envMaybe
, (.=)
, (.!=)
) where
import Control.Applicative
import Control.Monad.Except
import Control.Monad.Identity
import Control.Exception
import Data.Maybe
import Data.Time
import Data.Monoid
import Control.Monad
import Data.Typeable
import Data.String
import System.Environment
import Text.Read (readMaybe)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Map as M
import Data.Text (Text)
import Data.Word
import Data.Int
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as BL8
newtype Parser a = Parser { runParser :: ExceptT String IO a }
deriving ( Functor, Monad, Applicative, MonadError String
, MonadIO, Alternative, MonadPlus )
data EnvVar = EnvVar { getEnvVar :: (String, String) }
deriving (Show, Eq)
evalParser :: FromEnv a => Parser a -> IO (Either String a)
evalParser = runExceptT . runParser
getE
:: forall a . (Typeable a, Var a)
=> String
-> Parser a
getE k = do
result <- liftIO (lookupEnv k)
case result of
Nothing -> throwError $ "Variable not found for: " ++ k
Just dv ->
case fromVar dv :: Maybe a of
Nothing -> throwError $ "Parse failure: field <name> is not of type: "
++ show (typeOf dv)
Just x -> return x
env :: forall a. (Typeable a, Var a)
=> String
-> Parser a
env = getE
getEMaybe
:: forall a . (Typeable a, Var a)
=> String
-> Parser (Maybe a)
getEMaybe k = do
val <- liftIO (lookupEnv k)
return $ case val of
Nothing -> Nothing
Just x -> fromVar x
envMaybe :: forall a. (Typeable a, Var a)
=> String
-> Parser (Maybe a)
envMaybe = getEMaybe
(.!=) :: forall a. (Typeable a, Var a)
=> Parser (Maybe a)
-> a
-> Parser a
(.!=) p x = fmap (fromMaybe x) p
(.=) :: Var a
=> String
-> a
-> EnvVar
(.=) x y = EnvVar (x, toVar y)
class FromEnv a where
fromEnv :: Parser a
class Show a => ToEnv a where
toEnv :: EnvList a
data EnvList a = EnvList [EnvVar] deriving (Show)
makeEnv :: ToEnv a => [EnvVar] -> EnvList a
makeEnv = EnvList
class (Read a, Show a) => Var a where
toVar :: a -> String
fromVar :: String -> Maybe a
instance Var Text where
toVar = T.unpack
fromVar = Just . T.pack
instance Var TL.Text where
toVar = TL.unpack
fromVar = Just . TL.pack
instance Var BL8.ByteString where
toVar = BL8.unpack
fromVar = Just . BL8.pack
instance Var B8.ByteString where
toVar = B8.unpack
fromVar = Just . B8.pack
instance Var Int where
toVar = show
fromVar = readMaybe
instance Var Int8 where
toVar = show
fromVar = readMaybe
instance Var Int16 where
toVar = show
fromVar = readMaybe
instance Var Int32 where
toVar = show
fromVar = readMaybe
instance Var Int64 where
toVar = show
fromVar = readMaybe
instance Var Integer where
toVar = show
fromVar = readMaybe
instance Var UTCTime where
toVar = show
fromVar = readMaybe
instance Var Day where
toVar = show
fromVar = readMaybe
instance Var Word8 where
toVar = show
fromVar = readMaybe
instance Var Bool where
toVar = show
fromVar = readMaybe
instance Var Double where
toVar = show
fromVar = readMaybe
instance Var Word16 where
toVar = show
fromVar = readMaybe
instance Var Word32 where
toVar = show
fromVar = readMaybe
instance Var Word64 where
toVar = show
fromVar = readMaybe
instance Var String where
toVar = id
fromVar = Just
decodeEnv :: FromEnv a => IO (Either String a)
decodeEnv = evalParser fromEnv
decode :: FromEnv a => IO (Maybe a)
decode = fmap f decodeEnv
where
f (Left _) = Nothing
f (Right x) = Just x
setEnvironment :: EnvList a -> IO (Either String ())
setEnvironment (EnvList xs) = do
result <- try $ mapM_ (uncurry setEnv) (map getEnvVar xs)
return $ case result of
Left (ex :: IOException) -> Left (show ex)
Right () -> Right ()
unsetEnvironment :: EnvList a -> IO (Either String ())
unsetEnvironment (EnvList xs) = do
result <- try $ mapM_ unsetEnv $ map fst (map getEnvVar xs)
return $ case result of
Left (ex :: IOException) -> Left (show ex)
Right () -> Right ()
showEnv :: IO ()
showEnv = mapM_ print =<< getEnvironment