Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

snap-0.8; bump to version 0.2

  • Loading branch information...
commit 88d117bbc5b6dfef580a27c16c6323cea032e155 1 parent dd69ad8
@freizl freizl authored
View
14 Makefile
@@ -0,0 +1,14 @@
+DIST=dist
+
+default: build
+
+clean:
+ rm -rf $(DIST)
+
+build: clean
+ cabal configure
+ cabal build
+
+install: build
+ cabal install
+
View
30 snaplet-environments.cabal
@@ -7,7 +7,7 @@ Name: snaplet-environments
-- The package version. See the Haskell package versioning policy
-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
-- standards guiding when and how versions should be incremented.
-Version: 0.1
+Version: 0.2
-- A short (one-line) description of the package.
Synopsis: Provides ability to easly read configuration based on given app environment given at command line, envs are defined in app configuration file
@@ -52,22 +52,30 @@ Library
-- Packages needed in order to build this package.
Build-depends:
- base >= 4 && < 5,
- snap == 0.7.*,
- snap-core == 0.7.*,
- mtl >= 2 && < 3,
- configurator >= 0.2 && < 0.3,
- regex-tdfa >= 1.1.8 && < 1.2,
- unordered-containers >= 0.1.4.3 && < 0.2,
- text >= 0.11 && < 0.12,
- bson >= 0.1.6 && < 0.2
+ base >= 4 && < 5,
+ snap == 0.8.*,
+ snap-core == 0.8.*,
+ mtl >= 2 && < 3,
+ configurator >= 0.2 && < 0.3,
+ regex-tdfa >= 1.1.8 && < 1.2,
+ unordered-containers >= 0.1.4 && < 0.2,
+ text >= 0.11 && < 0.12,
+ bson >= 0.1.7 && < 0.2
-- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
-- Build-tools:
+ if impl(ghc >= 6.12.0)
+ ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
+ -fno-warn-orphans -fno-warn-unused-do-bind
+ -fno-spec-constr-count
+ else
+ ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
+ -fno-warn-orphans
+
extensions:
OverloadedStrings
, FlexibleInstances
, TypeSynonymInstances
, MultiParamTypeClasses
-
+
View
31 src/Snap/Snaplet/Environments.hs
@@ -1,14 +1,16 @@
module Snap.Snaplet.Environments
( module Data.Configurator
+ , lookupEnv
, lookupEnvDefault
, module Snap.Snaplet.Environments.Instances )
where
import Control.Monad.Reader
+import Data.Maybe (fromMaybe)
import Data.Configurator
import Data.Configurator.Types
import qualified Data.HashMap.Lazy as HM
-import Data.List (filter, find)
+import Data.List (find)
import qualified Data.Text as T
import Snap.Snaplet
import Snap.Snaplet.Environments.Instances
@@ -16,22 +18,31 @@ import System.Environment (getArgs)
import Text.Regex.TDFA
+-----------------------------------------------------------
+
+
+-- | Look up a given name without default value.
+--
+lookupEnv :: (Configured a, Monad (m b v), MonadSnaplet m, MonadIO (m b v)) => Name -> m b v (Maybe a)
+lookupEnv name = do
+ mainConf <- getSnapletUserConfig
+ subName <- getNameForCurEnv name mainConf
+ liftIO $ Data.Configurator.lookup mainConf subName
+
-- | This function takes current env subconfig and at its base
-- looks up given name
+--
lookupEnvDefault :: (Configured a, Monad (m b v), MonadSnaplet m, MonadIO (m b v)) => Name -> a -> m b v a
-lookupEnvDefault name def = do
- mainConf <- getSnapletUserConfig
- subName <- getNameForCurEnv name mainConf
- mv <- liftIO $ Data.Configurator.lookup mainConf subName
- case mv of
- Nothing -> liftIO $ lookupDefault def mainConf name
- Just v -> (liftIO $ putStrLn "Just") >> return v
+lookupEnvDefault name def = liftM (fromMaybe def) (lookupEnv name)
+
+-----------------------------------------------------------
getNameForCurEnv :: (Monad (m b v), MonadSnaplet m, MonadIO (m b v)) => Name -> Config -> m b v Name
getNameForCurEnv name cfg = do
env <- getCurrentEnv cfg
return $ T.pack $ "environments." ++ env ++ "." ++ (T.unpack name)
+
getCurrentEnv :: (Monad (m b v), MonadSnaplet m, MonadIO (m b v)) => Config -> m b v String
getCurrentEnv cfg = do
mopt <- return . find (\a -> take 1 a == "@") =<< liftIO getArgs
@@ -40,9 +51,9 @@ getCurrentEnv cfg = do
hm <- liftIO $ getMap cfg
case filter (\k -> (T.unpack k) =~ ("app.environments." :: String)) $ HM.keys hm of
[] -> error "You have to put at least one env definition in your config file."
- (x:xs) -> return $ T.unpack $ (T.split (== '.') x) !! 2
+ (x:_) -> return $ T.unpack $ (T.split (== '.') x) !! 2
Just opt -> do
hm <- liftIO $ getMap cfg
case length (filter (\k -> (T.unpack k) =~ ("app.environments." ++ (tail opt))) $ HM.keys hm) > 0 of
True -> return $ tail opt
- False -> error $ "Given env name: " ++ opt ++ " wasn't found in your config file."
+ False -> error $ "Given env name: " ++ opt ++ " wasn't found in your config file."
Please sign in to comment.
Something went wrong with that request. Please try again.