Rule.hs

module Control.Access.RoleBased.Internal.Rule where

------------------------------------------------------------------------------
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as M
import           Data.List (foldl')
import           Data.Monoid
import           Data.Text (Text)
------------------------------------------------------------------------------
import           Control.Access.RoleBased.Internal.Role


------------------------------------------------------------------------------
data Rule = Rule Text (Role -> [Role])


------------------------------------------------------------------------------
newtype RuleSet = RuleSet (HashMap Text (Role -> [Role]))


------------------------------------------------------------------------------
instance Monoid RuleSet where
    mempty = RuleSet M.empty
    (RuleSet m1) `mappend` (RuleSet m2) = RuleSet $ M.foldlWithKey' ins m2 m1
      where
        combine f1 f2 r = f1 r ++ f2 r
        ins m k v       = M.insertWith combine k v m


------------------------------------------------------------------------------
ruleToSet :: Rule -> RuleSet
ruleToSet (Rule nm f) = RuleSet $ M.singleton nm f


------------------------------------------------------------------------------
rulesToSet :: [Rule] -> RuleSet
rulesToSet = foldl' mappend (RuleSet M.empty) . map ruleToSet