module System.Envy
(
Env (..)
, FromEnv (..)
, ToEnv (..)
, Var (..)
, loadEnv
, decodeEnv
, decode
, showEnv
, setEnvironment
, unsetEnvironment
, makeEnv
, EnvList
, (.=)
, (.:)
, (.:?)
, (.!=)
) where
import Control.Applicative
import Control.Monad.Reader
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 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 Env = Env { env :: M.Map String String }
deriving (Show)
newtype Parser a = Parser { runParser :: ReaderT Env (ExceptT String IO) a }
deriving ( Functor, Monad, Applicative, MonadReader Env, MonadError String
, MonadIO, Alternative, MonadPlus )
data EnvVar = EnvVar { getEnvVar :: (String, String) }
deriving (Show, Eq)
evalParser :: FromEnv a => Parser a -> IO (Either String a)
evalParser stack = do
env <- liftIO loadEnv
runExceptT $ runReaderT (runParser stack) env
getE
:: forall a . (Typeable a, Var a)
=> String
-> Env
-> Parser a
getE k (Env m) = do
case M.lookup k m 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
getEMaybe
:: forall a . (Typeable a, Var a)
=> String
-> Env
-> Parser (Maybe a)
getEMaybe k (Env m) = do
return $ do
dv <- M.lookup k m
fromVar dv
(.:) :: forall a. (Typeable a, Var a)
=> String
-> Env
-> Parser a
(.:) = getE
(.=) :: Var a
=> String
-> a
-> EnvVar
(.=) x y = EnvVar (x, toVar y)
(.:?) :: forall a. (Typeable a, Var a)
=> String
-> Env
-> Parser (Maybe a)
(.:?) = getEMaybe
(.!=) :: forall a. (Typeable a, Var a)
=> Parser (Maybe a)
-> a
-> Parser a
(.!=) p x = fmap (fromMaybe x) p
class FromEnv a where
fromEnv :: Env -> Parser a
instance FromEnv Env where fromEnv = return
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
loadEnv :: IO Env
loadEnv = Env . M.fromList <$> getEnvironment
decodeEnv :: FromEnv a => IO (Either String a)
decodeEnv = loadEnv >>= evalParser . fromEnv
decode :: FromEnv a => IO (Maybe a)
decode = fmap f $ loadEnv >>= evalParser . fromEnv
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 :: Env -> IO ()
showEnv (Env xs) = mapM_ print (M.toList xs)