module Control.Access.RoleBased.Internal.RoleMap where

------------------------------------------------------------------------------
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as M
import           Data.HashSet (HashSet)
import qualified Data.HashSet as S
import           Data.List (find, foldl')
import           Data.Text (Text)
------------------------------------------------------------------------------
import           Control.Access.RoleBased.Role
import           Control.Access.RoleBased.Internal.Types


------------------------------------------------------------------------------
newtype RoleMap = RoleMap (HashMap Text (HashSet Role))


------------------------------------------------------------------------------
fromList :: [Role] -> RoleMap
fromList = RoleMap . foldl' ins M.empty
  where
    ins m role =
        M.insertWith S.union (_roleName role) (S.singleton role) m


------------------------------------------------------------------------------
lookup :: Role -> RoleMap -> Maybe Role
lookup role (RoleMap m) = find (`matches` role) l
  where
    l = maybe [] S.toList $ M.lookup (_roleName role) m


------------------------------------------------------------------------------
delete :: Role -> RoleMap -> RoleMap
delete role (RoleMap m) = RoleMap $ maybe m upd $ M.lookup rNm m
  where
    rNm = _roleName role
    upd s = maybe m
                  (\r -> let s' = S.delete r s
                         in if S.null s'
                              then M.delete rNm m
                              else M.insert rNm s' m)
                  (find (`matches` role) $ S.toList s)


------------------------------------------------------------------------------
insert :: Role -> RoleMap -> RoleMap
insert role (RoleMap m) =
    RoleMap $ M.insertWith S.union (_roleName role) (S.singleton role) m


------------------------------------------------------------------------------
empty :: RoleMap
empty = RoleMap M.empty


------------------------------------------------------------------------------
null :: RoleMap -> Bool
null (RoleMap m) = M.null m