snaplet-environments (empty) → 0.1

raw patch · 5 files changed

+162/−0 lines, 5 filesdep +basedep +bsondep +configuratorsetup-changed

Dependencies added: base, bson, configurator, haskell98, mtl, regex-tdfa, snap, snap-core, text, unordered-containers

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• snaplet-environments.cabal +74/−0
• src/Snap/Snaplet/Environments.hs +47/−0
• src/Snap/Snaplet/Environments/Instances.hs +9/−0

@@ -0,0 +1,30 @@+Copyright (c)2012, Kamil Ciemniewski++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Kamil Ciemniewski nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT+OWNER 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,74 @@+-- snaplet-environments.cabal auto-generated by cabal init. For+-- additional options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+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++-- 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++-- A longer description of the package.+-- Description:         ++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Kamil Ciemniewski++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          ciemniewski.kamil@gmail.com++-- A copyright notice.+-- Copyright:           ++Category:            Web++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.6+++Library+  hs-source-dirs: src++  library+  exposed-modules:  Snap.Snaplet.Environments,+                    Snap.Snaplet.Environments.Instances+  +  -- 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.0,+    regex-tdfa == 1.1.8,+    unordered-containers == 0.1.4.3,+    text >= 0.11 && < 0.12,+    haskell98 == 1.1.0.1,+    bson == 0.1.6+  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:    +  +  extensions: +      OverloadedStrings+    , FlexibleInstances+    , TypeSynonymInstances+    , MultiParamTypeClasses +  

@@ -0,0 +1,47 @@+module Snap.Snaplet.Environments( module Data.Configurator, lookupEnvDefault, module Snap.Snaplet.Environments.Instances ) where++import           System (getArgs) ++import           Control.Monad.Reader++import           Snap.Snaplet+import           Data.Configurator+import           Data.Configurator.Types++import           Snap.Snaplet.Environments.Instances++import qualified Data.Text as T+import qualified Data.HashMap.Lazy as HM+import           Data.List (filter, find)+import           Text.Regex.TDFA++-- | 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++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+  case mopt of+    Nothing  -> 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+    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."

@@ -0,0 +1,9 @@+module Snap.Snaplet.Environments.Instances where++import           Data.Configurator.Types+import qualified Data.UString as U+import qualified Data.Text as T++instance Configured U.UString where+  convert (String t) = Just $ U.u $ T.unpack t+  convert _ = Nothing