envy (empty) → 0.1.0.0
raw patch · 5 files changed
+509/−0 lines, 5 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, containers, envy, hspec, mtl, quickcheck-instances, text, time, transformers
Files
- LICENSE +30/−0
- Setup.lhs +4/−0
- envy.cabal +46/−0
- src/System/Envy.hs +288/−0
- tests/Main.hs +141/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, David Johnson++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ envy.cabal view
@@ -0,0 +1,46 @@+name: envy+version: 0.1.0.0+synopsis: An environmentally friendly way to deal with environment variables+license: BSD3+license-file: LICENSE+author: David Johnson+maintainer: djohnson.m@gmail.com+copyright: David Johnson (c) 2015+category: System+build-type: Simple+cabal-version: >=1.10+description:+ For package use information see: https://github.com/dmjio/envy/blob/master/README.md+library+ exposed-modules: System.Envy+ ghc-options: -Wall+ hs-source-dirs: src+ build-depends: base >= 4.7 && < 5+ , bytestring == 0.10.*+ , containers == 0.5.*+ , mtl == 2.2.*+ , text == 1.2.*+ , time == 1.5.*+ , transformers == 0.4.*+ default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ ghc-options: -Wall+ hs-source-dirs: tests+ main-is: Main.hs+ build-depends: base >= 4.7 && < 5+ , bytestring == 0.10.*+ , envy == 0.1.*+ , hspec == 2.1.*+ , mtl == 2.2.*+ , quickcheck-instances == 0.3.*+ , QuickCheck == 2.8.*+ , text == 1.2.*+ , time == 1.5.*+ , transformers == 0.4.*+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/dmjio/envy
+ src/System/Envy.hs view
@@ -0,0 +1,288 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}+------------------------------------------------------------------------------+-- |+-- Module : System.Envy+-- Copyright : (c) David Johnson 2015+-- Maintainer : djohnson.m@ngmail.com+-- Stability : experimental+-- Portability : POSIX+-- +------------------------------------------------------------------------------+module System.Envy+ ( -- * Types+ Env (..)+ -- * Classes+ , FromEnv (..)+ , ToEnv (..)+ , Var (..)+ -- * Functions+ , 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+------------------------------------------------------------------------------++------------------------------------------------------------------------------+-- | Environment+newtype Env = Env { env :: M.Map String String }+ deriving (Show)++------------------------------------------------------------------------------+-- | Parser+newtype Parser a = Parser { runParser :: ReaderT Env (ExceptT String IO) a }+ deriving ( Functor, Monad, Applicative, MonadReader Env, MonadError String+ , MonadIO, Alternative, MonadPlus )++------------------------------------------------------------------------------+-- | Variable type, smart constructor for handling Env. Variables+data EnvVar = EnvVar { getEnvVar :: (String, String) }+ deriving (Show, Eq)++------------------------------------------------------------------------------+-- | Execute Parser+evalParser :: FromEnv a => Parser a -> IO (Either String a)+evalParser stack = do+ env <- liftIO loadEnv+ runExceptT $ runReaderT (runParser stack) env++------------------------------------------------------------------------------+-- | Infix environment variable getter+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++------------------------------------------------------------------------------+-- | Infix environment variable getter+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 ++------------------------------------------------------------------------------+-- | Infix environment variable getter+(.:) :: forall a. (Typeable a, Var a)+ => String+ -> Env+ -> Parser a+(.:) = getE++------------------------------------------------------------------------------+-- | Infix environment variable setter +-- this is a smart constructor for producing types of `EnvVar`+(.=) :: Var a+ => String+ -> a+ -> EnvVar +(.=) x y = EnvVar (x, toVar y)++------------------------------------------------------------------------------+-- | Maybe parser+(.:?) :: forall a. (Typeable a, Var a)+ => String+ -> Env+ -> Parser (Maybe a)+(.:?) = getEMaybe++------------------------------------------------------------------------------+-- | For use with (.:?) for providing default arguments+(.!=) :: forall a. (Typeable a, Var a)+ => Parser (Maybe a)+ -> a+ -> Parser a +(.!=) p x = fmap (fromMaybe x) p++------------------------------------------------------------------------------+-- | FromEnv Typeclass+class FromEnv a where+ fromEnv :: Env -> Parser a++------------------------------------------------------------------------------+-- | Identity instance+instance FromEnv Env where fromEnv = return++------------------------------------------------------------------------------+-- | ToEnv Typeclass+class Show a => ToEnv a where+ toEnv :: EnvList a++------------------------------------------------------------------------------+-- | EnvList type w/ phanton+data EnvList a = EnvList [EnvVar] deriving (Show)++------------------------------------------------------------------------------+-- | smart constructor, Environment creation helper+makeEnv :: ToEnv a => [EnvVar] -> EnvList a+makeEnv = EnvList++------------------------------------------------------------------------------+-- | Class for converting to / from an environment variable+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 ++------------------------------------------------------------------------------+-- | Environment loading+loadEnv :: IO Env+loadEnv = Env . M.fromList <$> getEnvironment++------------------------------------------------------------------------------+-- | Environment retrieval with failure info+decodeEnv :: FromEnv a => IO (Either String a)+decodeEnv = loadEnv >>= evalParser . fromEnv++------------------------------------------------------------------------------+-- | Environment retrieval (with no failure info)+decode :: FromEnv a => IO (Maybe a)+decode = fmap f $ loadEnv >>= evalParser . fromEnv+ where+ f (Left _) = Nothing+ f (Right x) = Just x++------------------------------------------------------------------------------+-- | Set environment via a ToEnv constrained type+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 ()++------------------------------------------------------------------------------+-- | Unset Environment from a ToEnv constrained type+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 ()++------------------------------------------------------------------------------+-- | Env helper+showEnv :: Env -> IO ()+showEnv (Env xs) = mapM_ print (M.toList xs)
+ tests/Main.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+------------------------------------------------------------------------------+module Main ( main ) where+------------------------------------------------------------------------------+import Control.Applicative+import Control.Exception+import Control.Monad+import Control.Monad.Error+import Control.Monad.IO.Class (liftIO)+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy.Char8 as BL8+import Data.Either+import Data.Int+import Data.String+import Data.Text (Text)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import Data.Time+import Data.Typeable+import Data.Word+import System.Environment+import System.Envy+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Instances+------------------------------------------------------------------------------+-- | Posgtres Port+newtype PGPORT = PGPORT Word16+ deriving (Read, Show, Var, Typeable, Num)++------------------------------------------------------------------------------+-- | Postgres URL+newtype PGURL = PGURL String+ deriving (Read, Show, Var, IsString, Typeable)++------------------------------------------------------------------------------+-- | Postgres Host+newtype PGHOST = PGHOST String+ deriving (Read, Show, Var, IsString, Typeable)++------------------------------------------------------------------------------+-- | Postgres DB+newtype PGDB = PGDB String+ deriving (Read, Show, Var, IsString, Typeable)++------------------------------------------------------------------------------+-- | Postgres User+newtype PGUSER = PGUSER String+ deriving (Read, Show, Var, IsString, Typeable)++------------------------------------------------------------------------------+-- | Postgres Password+newtype PGPASS = PGPASS String+ deriving (Read, Show, Var, IsString, Typeable)++data ConnectInfo = ConnectInfo {+ pgHost :: PGHOST+ , pgDB :: PGDB+ , pgPass :: PGPASS+ , pgUrl :: PGURL+ , pgUser :: PGUSER+ } deriving (Show)++------------------------------------------------------------------------------+-- | Posgtres config+data PGConfig = PGConfig {+ pgConnectInfo :: ConnectInfo -- ^ Connnection Info+ } ++------------------------------------------------------------------------------+-- | Custom show instance+instance Show PGConfig where+ show PGConfig {..} = "<PGConfig>"++------------------------------------------------------------------------------+-- | FromEnv Instances, supports popular aeson combinators *and* IO+-- for dealing with connection pools+instance FromEnv PGConfig where+ fromEnv env = do+ PGConfig <$> (ConnectInfo <$> "PG_HOST" .:? env .!= ("localhost" :: PGHOST)+ <*> "PG_PORT" .: env + <*> "PG_USER" .: env + <*> "PG_PASS" .: env + <*> "PG_DB" .: env)++------------------------------------------------------------------------------+-- | To Environment Instances+instance ToEnv PGConfig where+ toEnv = makeEnv + [ "PG_HOST" .= PGHOST "localhost"+ , "PG_PORT" .= PGPORT 5432+ , "PG_USER" .= PGUSER "user"+ , "PG_PASS" .= PGPASS "pass"+ , "PG_DB" .= PGDB "db"+ ]++------------------------------------------------------------------------------+-- | Start tests+main :: IO ()+main = hspec $ do + describe "Var ismorphisms hold" $ do+ it "Word8 Var isomorphism" $ property $ + \(x :: Word8) -> Just x == fromVar (toVar x)+ it "Word16 Var isomorphism" $ property $ + \(x :: Word16) -> Just x == fromVar (toVar x)+ it "Word32 Var isomorphism" $ property $ + \(x :: Word32) -> Just x == fromVar (toVar x)+ it "Int Var isomorphism" $ property $ + \(x :: Int) -> Just x == fromVar (toVar x)+ it "Int8 Var isomorphism" $ property $ + \(x :: Int8) -> Just x == fromVar (toVar x)+ it "Int16 Var isomorphism" $ property $ + \(x :: Int16) -> Just x == fromVar (toVar x)+ it "Int32 Var isomorphism" $ property $ + \(x :: Int32) -> Just x == fromVar (toVar x)+ it "Int64 Var isomorphism" $ property $ + \(x :: Int64) -> Just x == fromVar (toVar x)+ it "String Var isomorphism" $ property $ + \(x :: String) -> Just x == fromVar (toVar x)+ it "Double Var isomorphism" $ property $ + \(x :: Double) -> Just x == fromVar (toVar x)+ it "UTCTime Var isomorphism" $ property $ + \(x :: UTCTime) -> Just x == fromVar (toVar x)+ it "ByteString Var isomorphism" $ property $ + \(x :: B8.ByteString) -> Just x == fromVar (toVar x)+ it "ByteString Var isomorphism" $ property $ + \(x :: BL8.ByteString) -> Just x == fromVar (toVar x)+ it "Lazy Text Var isomorphism" $ property $ + \(x :: LT.Text) -> Just x == fromVar (toVar x)+ it "Text Var isomorphism" $ property $ + \(x :: T.Text) -> Just x == fromVar (toVar x)+ describe "Can set to and from environment" $ do+ it "Should set environment" $ do+ setEnvironment (toEnv :: EnvList PGConfig)+ result <- decodeEnv :: IO (Either String PGConfig)+ result `shouldSatisfy` isRight