module Data.Model.Util (mutualGroups, transitiveClosure, Errors) where
import Control.Monad
import Control.Monad.Trans.State
import Data.Foldable (toList)
import Data.List
import qualified Data.Map as M
import Data.Maybe
mutualGroups :: (Ord r, Show r, Foldable t) => (a -> Maybe r) -> M.Map r (t a) -> [[r]]
mutualGroups getRef env = recs [] (M.keys env)
where
deps n = unsafely (transitiveClosure getRef env n)
recs gs [] = gs
recs gs (n:ns) =
let mutual = filter (\o -> n `elem` deps o) (deps n)
in recs (mutual:gs) (ns \\ mutual)
transitiveClosure :: (Ord r, Show r, Foldable t) => (a -> Maybe r) -> M.Map r (t a) -> r -> Either Errors [r]
transitiveClosure getRef env = execRec . deps
where
deps n = do
present <- (n `elem`) <$> gets seen
unless present $ do
modify (\st -> st {seen=n:seen st})
case M.lookup n env of
Nothing -> modify (\st -> st {errors=unwords ["transitiveClosure:Unknown reference to",show n]:errors st})
Just v -> mapM_ deps (mapMaybe getRef . toList $ v)
unsafely :: Either Errors c -> c
unsafely = either (error.unlines) id
execRec :: State (RecState r) a -> Either [String] [r]
execRec op = (\st -> if null (errors st) then Right (seen st) else Left (errors st)) $ execState op (RecState [] [])
data RecState r = RecState {seen::[r],errors::Errors} deriving Show
type Errors = [String]