Haskell Feature Flag Demo (Part 3)

The previous entry of the Haskell Feature Flag Demo series presents a feature flag demo implementation using simple types. It suffers from “boolean blindness:” it is possible/easy to pass the wrong feature flag configuration as an argument. This entry presents a feature flag demo implementation that addresses this problem using tagged feature flag configuration.

Demo2.FeatureFlag

For simplicity, the feature flags and feature flag API are defined in a single module. In a production application, it might be worth developing the feature flag API in a separate module/package.

The previous demo represents a feature flag configuration using Bool (or Maybe Bool). Function foo depends on feature flag Fix_202407_SomeBug_42 but any Bool value can be passed to it. It is up to the developer to manually ensure that the correct configuration is passed, and bugs occur when there is a mistake.

We would instead like to use the Haskell type system to ensure that configuration for a specific feature flag is passed. By representing this information at the type level, there is a compile-time error when there is a mistake. This is an example of using the type system to make a whole class of bugs impossible.

In this demo, current feature flags are defined using a generalized algebraic data type (GADT). Note that they specify the type of the configuration value. Current configuration has Bool values, as they are feature flags, but it would be possible to create other types of configuration as well.

data FeatureFlag :: Type -> Type where
  Fix_202407_SomeBug_42 :: FeatureFlag Bool
  Ref_202407_SomeBusinessLogic :: FeatureFlag Bool

Note that this requires the GADTs and PolyKinds GHC extensions.

It is not possible to derive Eq, Ord, or Show instances for such a type, but the some package provides GEq, GCompare, and GShow type classes that work with GADTs, and the dependent-sum-template package provides Template Haskell functions to generate them.

deriveGEq ''FeatureFlag
deriveGCompare ''FeatureFlag
deriveGShow ''FeatureFlag

Note that this requires the TemplateHaskell GHC extension.

While the previous demo stored feature flag configuration in a Map, this one stores it in a DMap, a “dependent map” provided the dependent-map package. The above GADT determines the keys as well as the type of value for each key in the map. This type is functor-parametric, and the Identity functor is used to store concrete configuration values.

type FeatureFlagMap = DMap FeatureFlag Identity

Type FeatureFlagConfig represents feature flag configuration. It is tagged with a FeatureFlag, and it wraps a value of the type specified in the GADT. Note that Maybe is used to represent feature flags without configuration.

newtype FeatureFlagConfig (tag :: FeatureFlag a)
  = FeatureFlagConfig
    { config :: Maybe a
    }
  deriving (Eq, Show)

Function config is used to get the Maybe value, while function configT returns true if the feature flag is not found and function configF returns false if the feature flag is not found.

configT :: FeatureFlagConfig (tag :: FeatureFlag Bool) -> Bool
configT = fromMaybe True . config

configF :: FeatureFlagConfig (tag :: FeatureFlag Bool) -> Bool
configF = fromMaybe False . config

Function lookup performs a lookup for the specified feature flag in a FeatureFlagMap and returns a FeatureFlagConfig, which is tagged with the feature flag. There are no lookupT or lookupF functions, as these are replaced by configT and configF.

lookup
  :: FeatureFlag a
  -> FeatureFlagMap
  -> FeatureFlagConfig (tag :: FeatureFlag a)
lookup ff = FeatureFlagConfig . fmap runIdentity . DMap.lookup ff

The global storage for this demo is the same as that of the previous demo, just with the different types.

globalFeatureFlagMap :: MVar FeatureFlagMap
globalFeatureFlagMap = unsafePerformIO MVar.newEmptyMVar
{-# NOINLINE globalFeatureFlagMap #-}

initialize :: MonadIO m => FeatureFlagMap -> m ()
initialize ffMap = liftIO $ do
    isSuccess <- MVar.tryPutMVar globalFeatureFlagMap ffMap
    unless isSuccess . void $ MVar.swapMVar globalFeatureFlagMap ffMap

Type class MonadFeatureFlags is the same as well, just using the different types. Remember that it requires the DefaultSignatures GHC extension.

class Monad m => MonadFeatureFlags m where
  -- | Get the feature flag configuration
  readM :: m FeatureFlagMap

  default readM :: MonadIO m => m FeatureFlagMap
  readM = liftIO $ MVar.readMVar globalFeatureFlagMap

instance MonadFeatureFlags IO

Function lookupM has the same implementation, just different types.

lookupM
  :: MonadFeatureFlags m
  => FeatureFlag a
  -> m (FeatureFlagConfig (tag :: FeatureFlag a))
lookupM ff = lookup ff <$> readM

Type class HasFeatureFlags and the related instances are the same as well, just using different types. Remember that it requires the FlexibleInstances GHC extension.

class HasFeatureFlags a where
  getFeatureFlags :: a -> FeatureFlagMap

instance HasFeatureFlags FeatureFlagMap where
  getFeatureFlags = id

instance (HasFeatureFlags env, Monad m)
    => MonadFeatureFlags (ReaderT env m) where
  readM = asks getFeatureFlags

Demo2.FeatureFlag.DB

The (mock) load function in the new demo constructs a DMap. Note that operator (==>), provided by package dependent-sum, uses pure to lift into the functor, Identity in this case.

load :: IO FF.FeatureFlagMap
load = pure $ DMap.fromList
    [ FF.Fix_202407_SomeBug_42 ==> True
    , FF.Ref_202407_SomeBusinessLogic ==> True
    ]

Demo2.IO

The IO demo application is the same as in the previous demo, refactored to use the different types.

Functions foo and bar now take tagged feature flag configuration. Attempting to pass different feature flag configuration results in a compile-time error.

foo :: FF.FeatureFlagConfig FF.Fix_202407_SomeBug_42 -> Int
foo ffSomeBug
    | FF.configT ffSomeBug = 42
    | otherwise            = 13

bar :: FF.FeatureFlagConfig FF.Ref_202407_SomeBusinessLogic -> Int -> Int
bar ffSomeBusinessLogic n
    | FF.configT ffSomeBusinessLogic = n + n
    | otherwise                      = 2 * n

Note that the DataKinds GHC extension is required to use a type like FF.FeatureFlagConfig FF.Fix_202407_SomeBug_42.

Function fooBar is just changed to use the different types.

fooBar :: IO Int
fooBar = do
    ffSomeBug <- FF.lookupM FF.Fix_202407_SomeBug_42
    ffSomeBusinessLogic <- FF.lookupM FF.Ref_202407_SomeBusinessLogic
    pure . bar ffSomeBusinessLogic $ foo ffSomeBug

Function run is the same, just with the different types.

run :: FF.FeatureFlagMap -> IO Int
run ffMap = do
    FF.initialize ffMap
    fooBar

Application

File app/demo2.hs simply loads the feature flag configuration, runs the program, and prints the result.

main :: IO ()
main = print =<< Demo2.IO.run =<< Demo2.FeatureFlag.DB.load

Code

The full source is available on GitHub.

This demo uses GHC 9.6.5 and can be run using the following command.

$ cabal run demo2

Alternatively, if you use Stack, run the demo using the following command.

$ stack run demo2