feature-flipper (empty) → 0.1.0.0
raw patch · 9 files changed
+440/−0 lines, 9 filesdep +QuickCheckdep +basedep +containerssetup-changed
Dependencies added: QuickCheck, base, containers, feature-flipper, hspec, mtl, text
Files
- LICENSE +30/−0
- README.md +29/−0
- Setup.hs +2/−0
- examples/environment-config/Main.hs +40/−0
- feature-flipper.cabal +73/−0
- src/Control/Flipper.hs +90/−0
- src/Control/Flipper/Types.hs +68/−0
- test/Control/FlipperSpec.hs +107/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Todd Mohney (c) 2017++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 Todd Mohney 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.
+ README.md view
@@ -0,0 +1,29 @@+# flipper++A light-weight library providing an interface for minimally obtrusive feature+toggles.++This library provides the main user interface and an in-memory feature flag+storage adapter.++Persisted storage adapters (think Postgres, Redis, etc) will be created as+separate packages.++This library is heavily inspired by @jnunemaker's work on Ruby's [Flipper](https://github.com/jnunemaker/flipper).+Thanks for paving the way!++## Installation++Add `feature-flipper` to your cabal file, then import `Control.Flipper` into+your module.++## Usage examples++- [Configuring feature flags from environment variables](https://github.com/toddmohney/flipper/tree/master/examples/environment-config)++## Roadmap++### Add storage adapters++- TODO: Create Postgres adapter+- TODO: Create Redis adapter
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/environment-config/Main.hs view
@@ -0,0 +1,40 @@+module Main where++import Control.Monad.State+import qualified Data.Map.Strict as Map+import Data.Maybe (maybe)+import qualified System.Environment as Env++import Control.Flipper++main :: IO ()+main = do+ features <- loadFeatures++ -- StateT has a HasFeatureFlags instance defined+ evalStateT runWithFeatureFlags features++runWithFeatureFlags :: (MonadIO m, HasFeatureFlags m)+ => m ()+runWithFeatureFlags = do+ whenEnabled+ "SOME_FEATURE"+ (liftIO $ putStrLn "We're running SOME_FEATURE!")++ whenEnabled+ "SOME_OTHER_FEATURE"+ (liftIO $ putStrLn "We're running SOME_OTHER_FEATURE!")++ liftIO $ putStrLn "Done!"++loadFeatures :: IO Features+loadFeatures = do+ -- load feature flags from the environment+ someFeatureEnabled <- maybe False read <$> Env.lookupEnv "SOME_FEATURE"+ someOtherFeatureEnabled <- maybe False read <$> Env.lookupEnv "SOME_OTHER_FEATURE"++ -- build flipper feature type+ pure . Features $ Map.fromList+ [ ("SOME_FEATURE", someFeatureEnabled)+ , ("SOME_OTHER_FEATURE", someOtherFeatureEnabled)+ ]
+ feature-flipper.cabal view
@@ -0,0 +1,73 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name: feature-flipper+version: 0.1.0.0+synopsis: A minimally obtrusive feature flag library+description: A minimally obtrusive feature flag library+homepage: https://github.com/toddmohney/feature-flipper#readme+bug-reports: https://github.com/toddmohney/feature-flipper/issues+license: MIT+license-file: LICENSE+author: Todd Mohney+maintainer: toddmohney@gmail.com+copyright: 2017 Todd Mohney+category: Web+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/toddmohney/feature-flipper++library+ hs-source-dirs:+ src+ default-extensions: OverloadedStrings+ ghc-options: -Wall -fwarn-unused-matches -fwarn-unused-binds -fwarn-unused-imports+ exposed-modules:+ Control.Flipper+ Control.Flipper.Types+ other-modules:+ Paths_feature_flipper+ build-depends:+ base >=4.7 && <5+ , containers+ , mtl+ , text+ default-language: Haskell2010++executable environment-config+ main-is: Main.hs+ hs-source-dirs:+ examples/environment-config+ default-extensions: OverloadedStrings+ ghc-options: -Wall -fwarn-unused-matches -fwarn-unused-binds -fwarn-unused-imports+ build-depends:+ base >=4.7 && <5+ , containers+ , feature-flipper+ , mtl+ default-language: Haskell2010++test-suite feature-flipper-test+ type: exitcode-stdio-1.0+ hs-source-dirs:+ test+ default-extensions: OverloadedStrings+ main-is: Spec.hs+ build-depends:+ base+ , containers+ , feature-flipper+ , hspec+ , mtl+ , QuickCheck+ other-modules:+ Control.FlipperSpec+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010
+ src/Control/Flipper.hs view
@@ -0,0 +1,90 @@+{-|+Module : Flipper+Description : Main user interface for the Flipper library+-}+module Control.Flipper+ ( enabled+ , enable+ , disable+ , toggle+ , whenEnabled+ , module Control.Flipper.Types+ ) where++import Control.Monad (void, when)+import qualified Data.Map.Strict as M++import Control.Flipper.Types (FeatureName(..), Features(..),+ HasFeatureFlags(..), ModifiesFeatureFlags(..), mkFeatures)++{- |+The 'whenEnabled' function calls the supplied function, 'm ()', when the given+'FeatureName' is enabled.++When the feature specified by 'FeatureName' is disabled, 'm ()' is not+evaluated.+-}+whenEnabled :: (HasFeatureFlags m)+ => FeatureName -> m () -> m ()+whenEnabled fName f = do+ isEnabled <- enabled fName+ when isEnabled f++{- |+The 'enabled' function returns a Bool indicating if the queried feature is+active.++When the queried FeatureName exists, the active state is returned.++When the queried FeatureName does not exists, 'enabled' returns False.+-}+enabled :: HasFeatureFlags m+ => FeatureName -> m Bool+enabled fName = do+ features <- unFeatures <$> getFeatures+ if M.lookup fName features == Just True+ then return True+ else return False++{- |+The 'enable' function activates a feature.++When the FeatureName exists in the store, it is set to active.++When the FeatureName does not exist, it is created and set to active.+-}+enable :: ModifiesFeatureFlags m+ => FeatureName -> m ()+enable fName = update fName (\_ -> Just True)++{- |+The 'disable' function deactivates a feature.++When the FeatureName exists in the store, it is set to inactive.++When the FeatureName does not exist, it is created and set to inactive.+-}+disable :: ModifiesFeatureFlags m+ => FeatureName -> m ()+disable fName = update fName (\_ -> Just False)++{- |+The 'toggle' function flips the current state of a feature.++When the FeatureName exists in the store, it flips the feature state.++When the FeatureName does not exist, it is created and set to True.+-}+toggle :: ModifiesFeatureFlags m+ => FeatureName -> m ()+toggle fName = update fName flipIt'+ where+ flipIt' :: Maybe Bool -> Maybe Bool+ flipIt' (Just a) = Just (not a)+ flipIt' Nothing = Just True++update :: ModifiesFeatureFlags m+ => FeatureName -> (Maybe Bool -> Maybe Bool) -> m ()+update fName updateFn = do+ features <- unFeatures <$> getFeatures+ void . updateFeatures . Features $ M.alter updateFn fName features
+ src/Control/Flipper/Types.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++{-|+Module : Flipper.Types+Description : Datatype and Typeclass definitions+-}+module Control.Flipper.Types+ ( Features(..)+ , FeatureName(..)+ , HasFeatureFlags(..)+ , ModifiesFeatureFlags(..)+ , mkFeatures+ ) where++import Control.Monad.State (StateT, get, put)+import Data.Map.Strict (Map)+import Data.Monoid+import Data.String (IsString (..))+import Data.Text (Text)+import qualified Data.Text as T++{- |+The 'HasFeatureFlags' typeclass describes how to access the Features store+within the current monad.+-}+class Monad m => HasFeatureFlags m where+ -- | 'getFeatures' access the Features store within the current monad+ getFeatures :: m Features++instance (Monad m) => HasFeatureFlags (StateT Features m) where+ getFeatures = get++{- |+The 'ModifiesFeatureFlags' typeclass describes how to modify the Features store+within the current monad.+-}+class HasFeatureFlags m => ModifiesFeatureFlags m where+ -- | 'updateFeatures' modifies the Features store within the current monad+ updateFeatures :: Features -> m ()++instance (Monad m) => ModifiesFeatureFlags (StateT Features m) where+ updateFeatures = put++{- |+An abstraction representing the current state of the features store.+-}+newtype Features = Features { unFeatures :: Map FeatureName Bool }+ deriving (Show, Eq)++instance Monoid Features where+ mempty = Features mempty+ mappend a b = Features (unFeatures a <> unFeatures b)++{- |+The main identifier of a feature+-}+newtype FeatureName = FeatureName { unFeatureName :: Text }+ deriving (Show, Eq, Ord)++instance IsString FeatureName where+ fromString s = FeatureName (T.pack s)++{- |+Convienience constructor+-}+mkFeatures :: Map FeatureName Bool -> Features+mkFeatures = Features
+ test/Control/FlipperSpec.hs view
@@ -0,0 +1,107 @@+module Control.FlipperSpec (main, spec) where++import Control.Monad.State (evalState, execState)+import qualified Data.Map.Strict as M+import Test.Hspec++import Control.Flipper++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "whenEnabled" $ do+ context "the feature is enabled" $+ it "evaluates the given monad" $+ let+ featureState = mkFeatures $ M.insert "ADD_ANOTHER_FEATURE" True mempty+ store = execState+ (whenEnabled "ADD_ANOTHER_FEATURE" (enable "ANOTHER_FEATURE"))+ featureState+ in+ M.lookup "ANOTHER_FEATURE" (unFeatures store) `shouldBe` Just True++ context "the feature is disabled" $+ it "does not evaluate the given monad" $+ let+ featureState = mkFeatures $ M.insert "ADD_ANOTHER_FEATURE" False mempty+ store = execState+ (whenEnabled "ADD_ANOTHER_FEATURE" (enable "ANOTHER_FEATURE"))+ featureState+ in+ M.lookup "ANOTHER_FEATURE" (unFeatures store) `shouldBe` Nothing++ describe "enable" $ do+ it "enables a new feature key" $+ let+ featureState = mempty :: Features+ result = evalState (enable "NEW_FEATURE" >> enabled "NEW_FEATURE") featureState+ in+ result `shouldBe` True++ it "enables a existing feature key" $+ let+ featureState = mkFeatures $ M.insert "FEATURE" False mempty+ result = evalState (enable "FEATURE" >> enabled "FEATURE") featureState+ in+ result `shouldBe` True++ describe "disable" $ do+ it "disables a new feature key" $+ let+ featureState = mempty :: Features+ result = evalState (disable "NEW_FEATURE" >> enabled "NEW_FEATURE") featureState+ in+ result `shouldBe` False++ it "disables a existing feature key" $+ let+ featureState = mkFeatures $ M.insert "FEATURE" True mempty+ result = evalState (disable "FEATURE" >> enabled "FEATURE") featureState+ in+ result `shouldBe` False++ describe "toggle" $ do+ it "enables a new feature key" $+ let+ featureState = mempty :: Features+ result = evalState (toggle "NEW_FEATURE" >> enabled "NEW_FEATURE") featureState+ in+ result `shouldBe` True++ it "enables a disabled feature key" $+ let+ featureState = mkFeatures $ M.insert "FEATURE" False mempty+ result = evalState (toggle "FEATURE" >> enabled "FEATURE") featureState+ in+ result `shouldBe` True++ it "disables a enabled feature key" $+ let+ featureState = mkFeatures $ M.insert "FEATURE" True mempty+ result = evalState (toggle "FEATURE" >> enabled "FEATURE") featureState+ in+ result `shouldBe` False++ describe "enabled" $ do+ it "returns True when the feature is enabled" $+ let+ featureState = mkFeatures $ M.insert "ENABLED_FEATURE" True mempty+ result = evalState (enabled "ENABLED_FEATURE") featureState+ in+ result `shouldBe` True++ it "returns False when the feature is not enabled" $+ let+ featureState = mkFeatures $ M.insert "DISABLED_FEATURE" False mempty+ result = evalState (enabled "DISABLED_FEATURE") featureState+ in+ result `shouldBe` False++ it "returns False when the feature key is not found" $+ let+ featureState = mempty :: Features+ result = evalState (enabled "NON_EXISTANT_FEATURE") featureState+ in+ result `shouldBe` False
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}