snap-configuration-utilities (empty) → 0.1.0.0

raw patch · 8 files changed

+207/−0 lines, 8 filesdep +basedep +configuratordep +textsetup-changed

Dependencies added: base, configurator, text, unordered-containers

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• lib/Snap/Utilities/Configuration.hs +17/−0
• lib/Snap/Utilities/Configuration/Extract.hs +34/−0
• lib/Snap/Utilities/Configuration/Keys.hs +37/−0
• lib/Snap/Utilities/Configuration/Lookup.hs +41/−0
• lib/Snap/Utilities/Configuration/Types.hs +12/−0
• snap-configuration-utilities.cabal +34/−0

@@ -0,0 +1,30 @@+Copyright (c) 2014, Anchor Systems++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 Anchor Systems 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,17 @@+module Snap.Utilities.Configuration (+    cfgLookup,+    cfgLookupWithDefault,+    stringValue,+    listValue,++    keyPre,+    rebaseKey,+    groupName,++    extractGroups,+    withValidGroup+) where++import Snap.Utilities.Configuration.Lookup+import Snap.Utilities.Configuration.Keys+import Snap.Utilities.Configuration.Extract

@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}++module Snap.Utilities.Configuration.Extract (+    extractGroups,+    withValidGroup+) where++import Prelude hiding (lookup)+import Control.Applicative+import qualified Data.Configurator as C+import qualified Data.Configurator.Types as CT+import Data.List (groupBy, intercalate, find, sortBy, lookup)+import Data.HashMap.Strict (toList)+import Data.Text (Text, isPrefixOf, splitOn, pack, unpack)++import Snap.Utilities.Configuration.Lookup+import Snap.Utilities.Configuration.Types+import Snap.Utilities.Configuration.Keys++------------------------------------------------------------------------------+extractGroups :: (ConfigPair -> Bool) -> CT.Config -> IO [[ConfigPair]]+extractGroups validator cfg = (groupBy authGroups . sortBy sortGroups . filter validator . toList) <$> C.getMap cfg+  where+    authGroups (k1, _) (k2, _) = (keyPre k1) == (keyPre k2)+    sortGroups (k1, _) (k2, _) = (keyPre k1) `compare` (keyPre k2)++withValidGroup :: String -> (String -> String -> [ConfigPair] -> a) -> [ConfigPair] -> a+withValidGroup groupKey transformer cfg =+    case fmap stringValue $ lookup (pack groupKey) cfg' of+        Just a -> transformer gn a cfg'+        _      -> error ("Not a valid " ++ groupKey ++ " in " ++ gn)+  where+    cfg' = map rebaseKey cfg+    gn   = groupName cfg

@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++module Snap.Utilities.Configuration.Keys (+	keyPre,+	rebaseKey,+	groupName+) where++import qualified Data.Configurator as C+import qualified Data.Configurator.Types as CT+import Data.List (groupBy, intercalate, find, sortBy)+import Data.HashMap.Strict (toList)+import Data.Text (Text, isPrefixOf, splitOn, pack, unpack)++import Snap.Utilities.Configuration.Types++------------------------------------------------------------------------------+-- | Get the prefix for a AuthDomain key.+keyPre :: Text -> [Text]+keyPre k = take l $ splitK k+  where+  	l = length (splitK k) - 1++-- | Reduce an AuthDomain key down to its last element.+rebaseKey :: ConfigPair -> ConfigPair+rebaseKey (k, v) = (head . drop l . splitK $ k, v)+  where+  	l = length (splitK k) - 1++-- | Get a name for a group of items.+-- Has to drop 1 because the first item is always the type of group.+groupName :: [ConfigPair] -> String+groupName = unpack . head . drop 1 . keyPre . fst . head++-- | Splits a Configurator key up by dot delimiter.+splitK :: Text -> [Text]+splitK = splitOn "."

@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++module Snap.Utilities.Configuration.Lookup (+	cfgLookup,+    cfgLookupWithDefault,+	stringValue,+	listValue+) where++import qualified Data.Configurator as C+import qualified Data.Configurator.Types as CT+import Data.List (groupBy, intercalate, find, sortBy)+import Data.HashMap.Strict (toList)+import Data.Text (Text, isPrefixOf, splitOn, pack, unpack)++import Snap.Utilities.Configuration.Types++------------------------------------------------------------------------------+-- | Look up a value.+cfgLookup :: Text -> (CT.Value -> a) -> [ConfigPair] -> Maybe a+cfgLookup key transformer = fmap (transformer . snd) . (found key)++-- | Look up a value and fall back to a default.+cfgLookupWithDefault :: Text -> a -> (CT.Value -> a) -> [ConfigPair] -> a+cfgLookupWithDefault key def transformer = maybe def (transformer . snd) . (found key)++-- | Internal: find a ConfigPair matching the key.+found :: Text -> [ConfigPair] -> Maybe ConfigPair+found key = find (\(k, _) -> k == key)++-- | Show a Configurator value as a String.+stringValue :: CT.Value -> String+stringValue (CT.String x) = unpack x+stringValue (CT.List x) = intercalate " " $ map show x+stringValue x = show x++-- | Show a Configurator value as a list.+listValue :: CT.Value -> [String]+listValue (CT.List x)   = map stringValue x+listValue (CT.String x) = map unpack . splitOn "," $ x+listValue x = listValue . CT.String . pack . show $ x

@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}++module Snap.Utilities.Configuration.Types (+	ConfigPair+) where++import qualified Data.Configurator.Types as CT+import Data.Text (Text)++------------------------------------------------------------------------------+-- | Look up a value.+type ConfigPair = (Text, CT.Value)

@@ -0,0 +1,34 @@+-- Initial snap-configuration-utilities.cabal generated by cabal init.  For+--  further documentation, see http://haskell.org/cabal/users-guide/++name:                snap-configuration-utilities+version:             0.1.0.0+synopsis:            Methods to manipulate Configurator objects for Snap & Snaplets+description:         Methods to manipulate Configurator objects for Snap & Snaplets+license:             BSD3+license-file:        LICENSE+author:              Geoffrey Roberts <geoffrey.roberts@anchor.com.au>+maintainer:          Anchor Engineering <engineering@anchor.com.au>+-- copyright:           +category:            Web+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++source-repository head+  type:                git+  location:            https://github.com/anchor/snap-configuration-utilities++library+  exposed-modules:     Snap.Utilities.Configuration+  other-modules:       Snap.Utilities.Configuration.Extract+                     , Snap.Utilities.Configuration.Keys+                     , Snap.Utilities.Configuration.Lookup+                     , Snap.Utilities.Configuration.Types+  -- other-extensions:    +  build-depends:       base >=4.7 && <4.8+                     , configurator+                     , text+                     , unordered-containers+  hs-source-dirs:      lib+  default-language:    Haskell2010