module Control.Flipper.Types
( ActorId(..)
, Feature(..)
, Features(..)
, FeatureName(..)
, HasActorId(..)
, HasFeatureFlags(..)
, ModifiesFeatureFlags(..)
, Percentage(..)
, update
, upsert
, isEnabledFor
, mkFeature
, mkFeatures
) where
import Control.Monad (void)
import Control.Monad.Reader
import Control.Monad.State
import Data.ByteString (ByteString)
import qualified Data.Digest.CRC32 as D
import qualified Data.List as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as S
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
class Monad m => HasFeatureFlags m where
getFeatures :: m Features
default getFeatures :: (MonadTrans t, HasFeatureFlags m1, m ~ t m1) => m Features
getFeatures = lift getFeatures
getFeature :: FeatureName -> m (Maybe Feature)
default getFeature :: (MonadTrans t, HasFeatureFlags m1, m ~ t m1) => FeatureName -> m (Maybe Feature)
getFeature = lift . getFeature
instance (MonadIO m, HasFeatureFlags m) => HasFeatureFlags (StateT s m)
instance (MonadIO m, HasFeatureFlags m) => HasFeatureFlags (ReaderT s m)
class HasFeatureFlags m => ModifiesFeatureFlags m where
updateFeatures :: Features -> m ()
default updateFeatures :: (MonadTrans t, ModifiesFeatureFlags m1, m ~ t m1) => Features -> m ()
updateFeatures = lift . updateFeatures
updateFeature :: FeatureName -> Feature -> m ()
default updateFeature :: (MonadTrans t, ModifiesFeatureFlags m1, m ~ t m1) => FeatureName -> Feature -> m ()
updateFeature fName feature = lift $ updateFeature fName feature
instance (MonadIO m, ModifiesFeatureFlags m) => ModifiesFeatureFlags (StateT s m)
instance (MonadIO m, ModifiesFeatureFlags m) => ModifiesFeatureFlags (ReaderT s m)
newtype ActorId = ActorId ByteString
deriving (Show, Eq, Ord, D.CRC32)
class HasActorId a where
actorId :: a -> ActorId
data Feature = Feature
{
featureName :: FeatureName
, isEnabled :: Bool
, enabledActors :: Set ActorId
, enabledPercentage :: Percentage
} deriving (Show, Eq)
mkFeature :: FeatureName -> Feature
mkFeature fname = Feature
{ featureName = fname
, isEnabled = False
, enabledActors = S.empty
, enabledPercentage = Percentage 0
}
newtype Percentage = Percentage Int
deriving (Show, Read, Eq, Ord, Num)
instance Bounded Percentage where
minBound = Percentage 0
maxBound = Percentage 100
newtype Features = Features { unFeatures :: Map FeatureName Feature }
deriving (Show)
instance Monoid Features where
mempty = Features mempty
mappend a b = Features (unFeatures a <> unFeatures b)
mkFeatures :: Features
mkFeatures = Features Map.empty
newtype FeatureName = FeatureName { unFeatureName :: Text }
deriving (Show, Eq, Ord)
instance IsString FeatureName where
fromString s = FeatureName (T.pack s)
upsert :: ModifiesFeatureFlags m
=> Feature -> m ()
upsert f = do
features <- unFeatures <$> getFeatures
void . updateFeatures . Features $ Map.insertWith mergeFeatures (featureName f) f features
mergeFeatures :: Feature -> Feature -> Feature
mergeFeatures new old = Feature
{ featureName = featureName new
, isEnabled = isEnabled new
, enabledActors = enabledActors old <> enabledActors new
, enabledPercentage = enabledPercentage new
}
update :: ModifiesFeatureFlags m
=> FeatureName -> (Maybe Feature -> Maybe Feature) -> m ()
update fName updateFn = do
features <- unFeatures <$> getFeatures
void . updateFeatures . Features $ Map.alter updateFn fName features
isEnabledFor :: (HasActorId a) => Feature -> a -> Bool
isEnabledFor (Feature _ globallyEnabled actors (Percentage pct)) actor =
globallyEnabled
|| inActivePercentageGroup
|| inActiveActorsGroup
where
inActivePercentageGroup = mod (actorHash actor) 100 < pct
inActiveActorsGroup = actorId actor `L.elem` actors
actorHash :: HasActorId a => a -> Int
actorHash a = fromIntegral . D.crc32 $ actorId a