global-config (empty) → 0.1.0

raw patch · 5 files changed

+196/−0 lines, 5 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, bytestring, data-default, global-config, global-variables, test-framework, test-framework-hunit, test-framework-quickcheck2, transformers

Files

LICENSE +25/−0
Setup.hs +2/−0
global-config.cabal +49/−0
src/Data/Global/Config.hs +59/−0
test/Main.hs +61/−0

+ LICENSE view

@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2011, John Lenz. 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.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "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 HOLDERS 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.hs view

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

+ global-config.cabal view

@@ -0,0 +1,49 @@+name:           global-config
+version:        0.1.0
+cabal-version:  >= 1.8
+build-type:     Simple
+author:         Alexander Dorofeev <aka.spin@gmail.com>spin
+maintainer:     Alexander Dorofeev <aka.spin@gmail.com>
+stability:      Experimental
+synopsis:       Global mutable configuration
+homepage:       https://github.com/akaspin/global-config
+bug-reports:    https://github.com/akaspin/global-config/issues
+category:       Configuration
+license-file:   LICENSE
+license:        BSD3
+description:    
+    @Data.Global.Config@ provides brain-free pattern to work with global 
+    configurations. Use wisely.
+
+source-repository head
+  type:         git
+  location:     git://github.com/akaspin/global-config.git
+
+library
+  hs-source-dirs:   src
+  build-depends:    base >= 4 && < 5,
+                   global-variables,
+                   data-default
+  ghc-options:      -Wall
+  exposed-modules:  Data.Global.Config
+
+test-suite test
+  type:            exitcode-stdio-1.0
+  x-uses-tf:       true
+  build-depends:   
+                   base >= 4 && < 5,
+                   HUnit >= 1.2 && < 2,
+                   QuickCheck >= 2.4,
+                   test-framework >= 0.4.1,
+                   test-framework-quickcheck2,
+                   test-framework-hunit,
+
+                   global-config,
+
+                   transformers,
+                   bytestring,
+                   data-default
+  ghc-options:     -Wall -rtsopts
+  hs-source-dirs:  test
+  main-is:         Main.hs
+

+ src/Data/Global/Config.hs view

@@ -0,0 +1,59 @@+
+-- | Main problem in haskell is \"creepy\" enviroment variables passed to all 
+--   functions. It's safe but tedious.
+--   
+--   'GlobalConfig' trying to solve this problem and propose common pattern 
+--   to work with configurations. It has been tested and proved to be very 
+--   useful in production.
+--   
+-- > {-# LANGUAGE DeriveDataTypeable #-}
+-- > 
+-- > module Main (main) where
+-- > 
+-- > import Data.Typeable (Typeable)
+-- > import Data.Default
+-- > import Data.Global.Config
+-- > 
+-- > data Config = Config { configInt :: Int, configBool :: Bool }
+-- >    deriving (Show, Typeable)
+-- > 
+-- > instance Default Config
+-- >    def = Config 0 False
+-- > 
+-- > instance GlobalConfig Config
+-- > 
+-- > main :: IO ()
+-- > main = do
+-- >    -- try to read unitialized config
+-- >    c1 <- getConfig 
+-- >    print (c1 :: Config)
+-- >    -- Config {configInt=0, configBool=False}
+-- >    
+-- >    -- set config and read it
+-- >    setConfig $ Config 1 True
+-- >    c2 <- getConfig
+-- >    print (c1 :: Config)
+-- >    -- Config {configInt=1, configBool=True}
+
+module Data.Global.Config (
+    GlobalConfig (setConfig, getConfig)
+) where
+
+import Data.Typeable (Typeable)
+import Data.Global (declareIORef)
+import Data.IORef (IORef, writeIORef, readIORef)
+import Data.Default (Default(def))
+
+-- | Global configuration class
+class (Default a, Typeable a) => GlobalConfig a where
+    -- | Init global config
+    setConfig :: a -> IO ()
+    setConfig e = stubConfig `writeIORef` e 
+    
+    -- | Get global config
+    getConfig :: IO a
+    getConfig = readIORef stubConfig
+    
+    -- | Stub enviroment
+    stubConfig :: IORef a
+    stubConfig = declareIORef "" def

+ test/Main.hs view

@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Main where
+
+import Test.Framework (defaultMain)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit (Assertion, (@=?))
+
+import Control.Monad.IO.Class (liftIO)
+
+import Data.Typeable (Typeable)
+import Data.Default
+import Data.ByteString (ByteString)
+import Data.ByteString.Char8 () -- Just for an orphan instance
+
+import Data.Global.Config
+
+main :: IO ()
+main = defaultMain [
+        testCase "Basic" caseBasic
+    ]
+
+---------------------------------------------------------------------------
+-- Test cases
+---------------------------------------------------------------------------
+
+caseBasic :: Assertion
+caseBasic = do
+    let c1 = Config 1 "first"
+    let c2 = Config 2 "second"
+
+    -- try to read unitialised config
+    c1f <- getConfig :: IO Config
+    liftIO $ c1f @=? def
+    
+    setConfig c1
+    c1' <- getConfig :: IO Config
+    liftIO $ c1' @=? c1
+
+    setConfig c2
+    c2' <- getConfig :: IO Config
+    liftIO $ c2' @=? c2
+
+---------------------------------------------------------------------------
+-- Test data types
+---------------------------------------------------------------------------
+
+-- First config
+data Config = Config {
+    tc1p1 :: Int,
+    tc1p2 :: ByteString
+  } deriving (Show, Eq, Typeable)
+  
+instance Default Config where
+    def = Config 0 ""
+    
+instance GlobalConfig Config
+
+    
+