env-parser (empty) → 0.0.1.0
raw patch · 10 files changed
+732/−0 lines, 10 filesdep +aesondep +attoparsecdep +basesetup-changed
Dependencies added: aeson, attoparsec, base, base16-bytestring, base64-bytestring, bytestring, containers, http-types, mtl, network, old-locale, text, time, transformers
Files
- ChangeLog +11/−0
- LICENSE +19/−0
- Setup.hs +2/−0
- env-parser.cabal +70/−0
- src/System/Environment/Parser.hs +136/−0
- src/System/Environment/Parser/Class.hs +84/−0
- src/System/Environment/Parser/Database.hs +122/−0
- src/System/Environment/Parser/Encoded.hs +88/−0
- src/System/Environment/Parser/FromEnv.hs +159/−0
- src/System/Environment/Parser/Miss.hs +41/−0
+ ChangeLog view
@@ -0,0 +1,11 @@+2014-01-18 Joseph Abrahamson <me@jspha.com>++ * src/System/Environment/Parser/Internal.hs: Introduced flexible environment structure designed for multiple implementations for IO and testing.+ * src/System/Environment/Parser/Internal.hs: Added dependency search+ * src/System/Environment/Parser/Internal.hs: FromEnv parsers for numbers and string types+ * src/System/Environment/Parser/Database.hs: Introduced DBConnection type with FromEnv instance+ * src/System/Environment/Parser/Internal.hs: Introduced FromEnv for Data.Time types+ * src/System/Environment/Parser/Encoded.hs: Added encoded bytestring types+ * src/System/Environment/Parser/Internal.hs: Introduced Aeson Value FromEnv instances+ * src/System/Environment/Parser/Encoded.hs: Added To/FromJSON instances for Encoded bytestrings+ * src/System/Environment/Parser/Internal.hs: Added envParse
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2013 Joseph Abrahamson++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ env-parser.cabal view
@@ -0,0 +1,70 @@+name: env-parser+version: 0.0.1.0+synopsis: Pull configuration information from the ENV+description: + @env-parser@ is a small library for configuring programs based on information+ from the environment.+ .+ Command-line oriented programs tend to pull much of their runtime+ configuration from command-line arguments and libraries such as @cmdargs@ are+ useful for encoding this configuration in your program. For programs which+ draw configuration from the environment, however, this must usually be done+ manually.+ .+ @env-parser@ focuses on making ENV-configured programs both easy to build,+ declarative, self-documenting, and easy to test.+ .+ A particular use case of this parser is to make it easy to build applications+ which launch under Heroku-style infrastructure. We provide explicit parsers+ for some of Heroku's conventions for this purpose.++homepage: http://github.com/tel/env-parser+license: MIT+license-file: LICENSE+author: Joseph Abrahamson+maintainer: me@jspha.com+copyright: 2013 (c) Joseph Abrahamson+category: System+build-type: Simple+extra-source-files: ChangeLog+cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/tel/env-parser.git++library+ exposed-modules: + System.Environment.Parser+ System.Environment.Parser.Database+ System.Environment.Parser.Encoded+ System.Environment.Parser.FromEnv+ other-modules:+ System.Environment.Parser.Class+ System.Environment.Parser.Miss+ build-depends: base >= 4.6 && <4.7++ -- Haskell Platform 2013.2.0.0++ , attoparsec >= 0.10+ , bytestring >= 0.10+ , containers >= 0.4+ , mtl >= 2.1+ , network >= 2.4+ , old-locale >= 1.0+ , text >= 0.11+ , time >= 1.4+ , transformers >= 0.3++ -- Soon to be Platformed++ , aeson >= 0.7++ -- Others++ , base16-bytestring >= 0.1.1+ , base64-bytestring >= 1.0+ , http-types >= 0.8++ hs-source-dirs: src+ default-language: Haskell2010
+ src/System/Environment/Parser.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- |+-- Module : System.Environment.Parser+-- Copyright : (c) Joseph Abrahamson 2013+-- License : MIT+--+-- Maintainer : me@jspha.com+-- Stability : experimental+-- Portability : non-portable+--+-- Functions for building generic environment parsers which provide+-- automatic documentation and easy testing.+--+module System.Environment.Parser (++ -- * Basic interface++ run -- :: Parser a -> IO (Either Errors a)+ , test -- :: Parser a -> Map.Map String String -> Either Errors a+ , help -- :: Parser a -> Dep+ , get -- :: FromEnv a => String -> Parser a+ , getParse -- :: FE.FromEnv a => (a -> Either String b) -> String -> Parser b+ , json -- :: FromJSON a => String -> Parser a++ -- * Interface types++ , Parser+ , Errors (..), Err (..)+ , Dep (..), references++ ) where++import Control.Applicative+import qualified Data.Aeson as Ae+import qualified Data.Aeson.Types as Ae+import Data.Functor.Compose+import qualified Data.Map as Map+import Data.Monoid+import Data.Foldable (toList, foldMap)+import Data.Sequence ((<|), (|>))+import qualified Data.Sequence as Seq+import qualified System.Environment.Parser.Class as Cls+import qualified System.Environment.Parser.FromEnv as FE+import System.Environment.Parser.Miss++-- -----------------------------------------------------------------------------+-- Error types++data Err = Wanted String | Joined String+ deriving ( Eq, Ord, Show )++newtype Errors = Errors { getErrors :: Seq.Seq Err }+ deriving ( Eq, Ord, Show, Monoid )++instance Cls.Satisfiable Errors where+ wants = Errors . Seq.singleton . Wanted+ errors = Errors . Seq.singleton . Joined++-- -----------------------------------------------------------------------------+-- Analysis types++data Dep = Succeeding+ | Needing String+ | Branching (Seq.Seq Dep)+ | Joining Dep+ | Defaulting String Dep+ deriving ( Eq, Show )++references :: Dep -> [String]+references = toList . foldDep where+ foldDep Succeeding = Seq.empty+ foldDep (Needing key) = Seq.singleton key+ foldDep (Branching ds) = foldMap foldDep ds+ foldDep (Joining d) = foldDep d+ foldDep (Defaulting _ d) = foldDep d++data Df a = Df { runDf :: Dep } deriving Functor++instance Applicative Df where+ pure _ = Df Succeeding+ Df (Branching dfs) <*> Df (Branching dxs) = Df (Branching $ dfs <> dxs)+ Df (Branching dfs) <*> Df dx = Df (Branching $ dfs |> dx)+ Df df <*> Df (Branching dxs) = Df (Branching $ df <| dxs)+ Df df <*> Df dx = Df (Branching $ Seq.fromList [df, dx])++instance Cls.HasEnv Df where+ getEnv key = Df (Needing key)++instance Cls.Env Df where+ joinFailure (Df dep) = Df (Joining dep)+ def a sho (Df dep) = Df (Defaulting (sho a) dep)++-- -----------------------------------------------------------------------------+-- Parser types++data Parser a = Parser+ { run' :: Compose IO (Miss Errors) a+ , test' :: Compose ((->) (Map.Map String String)) (Miss Errors) a+ , help' :: Df a+ }+ deriving ( Functor )++instance Applicative Parser where+ pure a = Parser (pure a) (pure a) (pure a)+ Parser f1 f2 f3 <*> Parser x1 x2 x3 =+ Parser (f1 <*> x1) (f2 <*> x2) (f3 <*> x3)++instance Cls.HasEnv Parser where+ getEnv key = Parser (Cls.getEnv key) (Cls.getEnv key) (Cls.getEnv key)++instance Cls.Env Parser where+ joinFailure (Parser i1 i2 i3) =+ Parser (Cls.joinFailure i1) (Cls.joinFailure i2) (Cls.joinFailure i3)+ def a sho (Parser i1 i2 i3) =+ Parser (Cls.def a sho i1) (Cls.def a sho i2) (Cls.def a sho i3)++run :: Parser a -> IO (Either Errors a)+run = fmap toEither . getCompose . run'++test :: Parser a -> Map.Map String String -> Either Errors a+test = fmap toEither . getCompose . test'++help :: Parser a -> Dep+help = runDf . help'++get :: FE.FromEnv a => String -> Parser a+get = FE.fromEnv . Cls.getEnv++json :: Ae.FromJSON a => String -> Parser a+json = getParse (Ae.parseEither Ae.parseJSON)++getParse :: FE.FromEnv a => (a -> Either String b) -> String -> Parser b+getParse parse key = Cls.joinFailure $ fmap parse $ get key
+ src/System/Environment/Parser/Class.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE FlexibleInstances #-}+-- |+-- Module : System.Environment.Parser.Class+-- Copyright : (c) Joseph Abrahamson 2013+-- License : MIT+--+-- Maintainer : me@jspha.com+-- Stability : experimental+-- Portability : non-portable+--+module System.Environment.Parser.Class where++import Control.Applicative+import qualified Control.Exception as E+import Data.Functor.Compose+import qualified Data.Map as Map+import Data.Monoid+import qualified System.Environment as Env+import System.Environment.Parser.Miss++-- -----------------------------------------------------------------------------+-- The HasEnv class++-- | 'HasEnv' is an adapter abstracting the raw IO-based environment+-- lookup. This lets us simulate a run of our parser in a fake environment.+class HasEnv r where+ getEnv :: String -> r String++instance HasEnv IO where+ getEnv = Env.getEnv++getEnvSafe :: String -> IO (Maybe String)+getEnvSafe key = do+ v <- E.try (getEnv key)+ return $ case v :: Either E.SomeException String of+ Left _ -> Nothing+ Right a -> Just a++instance (HasEnv f, Applicative f) => HasEnv (Compose IO f) where+ getEnv key = Compose $ maybe (getEnv key) pure <$> getEnvSafe key++instance (HasEnv f, Applicative f)+ => HasEnv (Compose ((->) (Map.Map String String)) f) where+ getEnv key = Compose $ maybe (getEnv key) pure . Map.lookup key++-- ----------------------------------------------------------------------------+-- Satisfiable class++class Monoid a => Satisfiable a where+ wants :: String -> a+ errors :: String -> a++-- ----------------------------------------------------------------------------+-- The Env class++class Applicative r => Env r where+ -- | Express that a parse has failed+ joinFailure :: r (Either String a) -> r a++ -- | Replace a result with a default if necessary+ def :: a -> (a -> String) -> r a -> r a++instance Satisfiable e => HasEnv (Miss e) where+ getEnv key = Miss (wants key)++instance Satisfiable e => Env (Miss e) where+ joinFailure (Miss er) = Miss er+ joinFailure (Got (Left er)) = Miss (errors er)+ joinFailure (Got (Right a)) = Got a++ def a _ (Miss _) = Got a+ def _ _ (Got a) = Got a++instance (Applicative f, Env g) => Env (Compose f g) where+ joinFailure = Compose . fmap joinFailure . getCompose+ def a sho = Compose . fmap (def a sho) . getCompose++-- | Default a 'Show'-able type.+defShow :: (Show a, Env r) => a -> r a -> r a+defShow a = def a show++-- | Default a type with a constant string.+defNoShow :: Env r => a -> String -> r a -> r a+defNoShow a str = def a (const str)
+ src/System/Environment/Parser/Database.hs view
@@ -0,0 +1,122 @@++-- |+-- Module : System.Environment.Parser.Database+-- Copyright : (c) Joseph Abrahamson 2013+-- License : MIT+--+-- Maintainer : me@jspha.com+-- Stability : experimental+-- Portability : non-portable+--+-- Heroku-style database connection URL parsing.+module System.Environment.Parser.Database (++ DBConnection (..), Provider (..), providerString++ ) where++import Control.Applicative+import qualified Data.Attoparsec.Text as At+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import qualified Data.Map as Map+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Network.HTTP.Types as Ht+import qualified Network.URI as URI+import System.Environment.Parser.FromEnv++----------------------------------------------------------------------------+-- Heroku-style DB urls++-- | Provider indicates what kind of database provider scheme this URL+-- refers to. This provides a small amount of convenience around URL+-- detection, but if detection fails use 'providerName' to extract the raw+-- string.+data Provider = Postgres S.ByteString+ | MySQL S.ByteString+ | AMQP S.ByteString+ | HTTP S.ByteString+ | Other S.ByteString++providerString :: Provider -> S.ByteString+providerString p = case p of+ Postgres s -> s+ MySQL s -> s+ AMQP s -> s+ HTTP s -> s+ Other s -> s++-- | A type representing the information that can be parsed from+-- a URL-style database configuration. For example consider the following+-- URLs+--+-- > postgres://user3123:passkja83kd8@ec2-117-21-174-214.compute-1.amazonaws.com:6212/db982398+-- > mysql://adffdadf2341:adf4234@us-cdbr-east.cleardb.com/heroku_db?reconnect=true+-- > mysql2://adffdadf2341:adf4234@us-cdbr-east.cleardb.com/heroku_db?reconnect=true+-- > http://user:pass@instance.ip/resourceid+-- > amqp://user:pass@ec2.clustername.cloudamqp.com/vhost+--+-- We assume that all the information in these URLs is provided---if+-- a username or password is unnecessary then it must be passed as an empty+-- string and not omitted.+--+data DBConnection = DBConnection+ { provider :: Provider+ , host :: S.ByteString+ , username :: S.ByteString+ , password :: S.ByteString+ , port :: Int+ , location :: S.ByteString+ , params :: Map.Map S.ByteString S.ByteString+ }++instance FromEnv DBConnection where+ parseEnv = tryParse++tryParse :: String -> Either String DBConnection+tryParse s = do+ uri <- e "invalid URI format" $ URI.parseAbsoluteURI s+ auth <- e "URI authority segment missing" $ URI.uriAuthority uri+ port <- parsePort (URI.uriPort auth)+ (username, password) <- parseUserPw (URI.uriUserInfo auth)++ return DBConnection+ { provider = guessProvider (URI.uriScheme uri)+ , host = S8.pack (URI.uriRegName auth)+ , username = username+ , password = password+ , port = port+ , location = S8.pack $ drop 1 $ URI.uriPath uri+ , params = makeQueryMap (URI.uriQuery uri)+ }++ where++ guessProvider :: String -> Provider+ guessProvider x = case x of+ "postgres:" -> Postgres bs+ "mysql:" -> MySQL bs+ "mysql2:" -> MySQL bs+ "http:" -> HTTP bs+ "amqp:" -> AMQP bs+ _ -> Other bs+ where bs = S8.pack s++ parsePort :: String -> Either String Int+ parsePort = At.parseOnly (At.char ':' *> At.decimal) . T.pack++ parseUserPw :: String -> Either String (S.ByteString, S.ByteString)+ parseUserPw = At.parseOnly ( (,) <$> (TE.encodeUtf8 <$> At.takeTill (==':') <* At.char ':')+ <*> (TE.encodeUtf8 <$> At.takeTill (=='@') <* At.char '@') )+ . T.pack++ makeQueryMap :: String -> Map.Map S.ByteString S.ByteString+ makeQueryMap = Map.fromList . Ht.parseSimpleQuery . S8.pack++-- -----------------------------------------------------------------------------+-- Utilities++e :: String -> Maybe a -> Either String a+e s Nothing = Left s+e _ (Just a) = Right a
+ src/System/Environment/Parser/Encoded.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- |+-- Module : System.Environment.Parser.Encoded+-- Copyright : (c) Joseph Abrahamson 2013+-- License : MIT+--+-- Maintainer : me@jspha.com+-- Stability : experimental+-- Portability : non-portable+--+-- Often it's useful to pass binary data through the environment as an+-- encoded string. This module provides handy types for specifying these+-- kinds of data.+--+-- @+-- data SecretKeys = Sk { key1 :: Base64, key2 :: Base64 }+-- @+--+module System.Environment.Parser.Encoded (++ Base64 (..), Base64Url (..), Base16 (..)++ ) where++import Control.Monad+import qualified Data.Aeson as Ae+import qualified Data.ByteString as S+import qualified Data.ByteString.Base16 as S16+import qualified Data.ByteString.Base64 as S64+import qualified Data.ByteString.Base64.URL as S64U+import qualified Data.Text.Encoding as Te+import System.Environment.Parser.FromEnv++-- | Isomorphic to a 'S.ByteString', a type which prefers to be base-64+-- encoded.+newtype Base64 = Base64 { unBase64 :: S.ByteString }+ deriving ( Eq, Ord, Show )++-- | Isomorphic to a 'S.ByteString', a type which prefers to be base-64-url+-- encoded (see <http://www.apps.ietf.org/rfc/rfc4648.html>).+newtype Base64Url = Base64Url { unBase64Url :: S.ByteString }+ deriving ( Eq, Ord, Show )++-- | Isomorphic to a 'S.ByteString', a type which prefers to be hexadecimal+-- encoded.+newtype Base16 = Base16 { unBase16 :: S.ByteString }+ deriving ( Eq, Ord, Show )++instance FromEnv Base64 where+ parseEnv = fmap Base64 . S64.decode <=< parseEnv++instance FromEnv Base64Url where+ parseEnv = fmap Base64Url . S64U.decode <=< parseEnv++instance FromEnv Base16 where+ parseEnv = fmap Base16 . s16decode <=< parseEnv where+ s16decode :: S.ByteString -> Either String S.ByteString+ s16decode bs = case S16.decode bs of+ (out, rest) | S.null rest -> Right out+ | otherwise -> Left "failed to decode hexadecimal string"++instance Ae.FromJSON Base64 where+ parseJSON = Ae.withText "base64 encoded string" $ \t ->+ case S64.decode (Te.encodeUtf8 t) of+ Left err -> fail err+ Right b -> return (Base64 b)++instance Ae.ToJSON Base64 where+ toJSON (Base64 bs) = Ae.String $ Te.decodeUtf8 $ S64.encode bs++instance Ae.FromJSON Base64Url where+ parseJSON = Ae.withText "base64url encoded string" $ \t ->+ case S64U.decode (Te.encodeUtf8 t) of+ Left err -> fail err+ Right b -> return (Base64Url b)++instance Ae.ToJSON Base64Url where+ toJSON (Base64Url bs) = Ae.String $ Te.decodeUtf8 $ S64U.encode bs++instance Ae.FromJSON Base16 where+ parseJSON = Ae.withText "base64 encoded string" $ \t ->+ case S16.decode (Te.encodeUtf8 t) of+ (out, rest) | S.null rest -> return (Base16 out)+ | otherwise -> fail "failed to decode hexadecimal string"++instance Ae.ToJSON Base16 where+ toJSON (Base16 bs) = Ae.String $ Te.decodeUtf8 $ S16.encode bs
+ src/System/Environment/Parser/FromEnv.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- |+-- Module : System.Environment.Parser.Internal+-- Copyright : (c) Joseph Abrahamson 2013+-- License : MIT+--+-- Maintainer : me@jspha.com+-- Stability : experimental+-- Portability : non-portable+--+-- Types which can be deserialized from an environment variable.++module System.Environment.Parser.FromEnv (++ FromEnv (..)++ ) where++import Control.Applicative+import Control.Monad+import qualified Data.Aeson as Ae+import qualified Data.Attoparsec.Text as At+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as SL+import qualified Data.ByteString.Lazy.Char8 as SL8+import Data.Int+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Data.Time+import System.Environment.Parser.Class+import System.Locale++-- | Types instantiatiating 'FromEnv' can be deserialized from the+-- environment directly.+class FromEnv a where+ parseEnv :: String -> Either String a++ -- | For this most part this should be left as default. It's useful for+ -- introducing non-failing parsers, though.+ fromEnv :: Env r => r String -> r a+ fromEnv = joinFailure . fmap parseEnv+++instance FromEnv String where+ parseEnv = Right+ fromEnv = id++instance FromEnv S.ByteString where+ parseEnv s = Right (S8.pack s)+ fromEnv = fmap S8.pack++instance FromEnv SL.ByteString where+ parseEnv s = Right (SL8.pack s)+ fromEnv = fmap SL8.pack++instance FromEnv T.Text where+ parseEnv s = Right (T.pack s)+ fromEnv = fmap T.pack++instance FromEnv TL.Text where+ parseEnv s = Right (TL.pack s)+ fromEnv = fmap TL.pack++integralEnv :: Integral a => String -> Either String a+integralEnv s = do+ txt <- parseEnv s+ At.parseOnly (At.signed At.decimal) txt where++instance FromEnv Int where parseEnv = integralEnv+instance FromEnv Integer where parseEnv = integralEnv+instance FromEnv Int8 where parseEnv = integralEnv+instance FromEnv Int64 where parseEnv = integralEnv+instance FromEnv Int32 where parseEnv = integralEnv+instance FromEnv Int16 where parseEnv = integralEnv++instance FromEnv Double where+ parseEnv s = do+ txt <- parseEnv s+ At.parseOnly (At.signed At.double) txt++instance FromEnv At.Number where+ parseEnv s = do+ txt <- parseEnv s+ At.parseOnly (At.signed At.number) txt++-- ----------------------------------------------------------------------------+-- Time parsers+--+-- These may not always be the most apropriate formats for parsing time,+-- but customer parser can always be appended as needed. Instead, these+-- provide convention.++-- | Interprets a string as a decimal number of seconds+instance FromEnv DiffTime where+ parseEnv s =+ realToFrac <$> (parseEnv s :: Either String At.Number)++-- | Interprets a string as a decimal number of seconds+instance FromEnv NominalDiffTime where+ parseEnv s =+ realToFrac <$> (parseEnv s :: Either String At.Number)++-- | Assumes first that the date is formatted as the W3C Profile of ISO+-- 8601 but also implements a few other formats.+--+-- > %Y-%m-%dT%H:%M:%S%Q%z+-- >+-- > 1997-07-16T19:20:30.45+01:00+-- > 1997-07-16T19:20:30.45Z+-- > 1997-07-16T19:20:30Z+--+-- > %a %b %_d %H:%M:%S %z %Y+-- >+-- > Sat Jan 18 22:20:02 +0000 2014+-- > Sat Jan 18 22:20:02 2014+-- > Jan 18 22:20:02 2014+--+instance FromEnv UTCTime where+ parseEnv s =+ e "bad UTC time"+ $ msum $ map (\format -> parseTime defaultTimeLocale format s) formats++ where+ formats =+ [ "%Y-%m-%dT%H:%M:%S%Q%z"+ , "%Y-%m-%dT%H:%M:%S%QZ"+ , "%a %b %_d %H:%M:%S %z %Y"+ , "%a %b %_d %H:%M:%S %Y"+ , "%b %_d %H:%M:%S %Y"+ ]++-- | Parses the Gregorian calendar format @\"%Y-%m-%d\"@.+instance FromEnv Day where+ parseEnv s =+ e "bad date" $ parseTime defaultTimeLocale "%Y-%m-%d" s+++-- ----------------------------------------------------------------------------+-- JSON Parsers+--+-- JSON is such a convenient format that it might be conceivably jammed+-- into an environment variable. Since Aeson will soon be in the Haskell+-- platform we'll go ahead and include some obvious default instances for+-- Aeson Value types along with a nice general parser.++instance FromEnv Ae.Value where+ parseEnv s = do+ bs <- parseEnv s+ Ae.eitherDecodeStrict bs++-- ----------------------------------------------------------------------------+-- Utilities++e :: String -> Maybe a -> Either String a+e s Nothing = Left s+e _ (Just a) = Right a
+ src/System/Environment/Parser/Miss.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DeriveFunctor #-}++-- |+-- Module : System.Environment.Parser.Miss+-- Copyright : (c) Joseph Abrahamson 2013+-- License : MIT+--+-- Maintainer : me@jspha.com+-- Stability : experimental+-- Portability : non-portable+-- +-- A purely Applicative Either.++module System.Environment.Parser.Miss where++import Control.Applicative+import Data.Monoid++data Miss e a+ = Got a+ | Miss e+ deriving ( Eq, Ord, Show, Read, Functor )++instance Monoid e => Applicative (Miss e) where+ pure = Got+ Miss e1 <*> Miss e2 = Miss (e1 <> e2)+ Miss e1 <*> _ = Miss e1+ _ <*> Miss e2 = Miss e2+ Got f <*> Got x = Got (f x)++toEither :: Miss e a -> Either e a+toEither (Miss e) = Left e+toEither (Got a) = Right a++missMap :: (e -> f) -> Miss e a -> Miss f a+missMap f (Miss e) = Miss (f e)+missMap _ (Got a) = Got a++gotMap :: (a -> b) -> Miss e a -> Miss e b+gotMap _ (Miss e) = Miss e+gotMap f (Got a) = Got (f a)