Clean up util

This commit is contained in:
Joscha 2019-11-05 10:27:25 +00:00
parent 2a60939aee
commit 8b5444f585

View file

@ -2,16 +2,6 @@
module Rextra.Util
( connectedElements
-- * Renaming
, Rename
, doRename
, getName
, renameSet
, renameMap
, renameKeys
, renameValues
-- * Grouping
, fromMonoidalList
, groupByFirst
) where
@ -32,40 +22,5 @@ connectedElements :: (Ord n) => (n -> Set.Set n) -> Set.Set n -> Set.Set n
connectedElements trans startingNodes =
flip execState Set.empty . mapM (explore trans) $ Set.toList startingNodes
type Rename n = State (Int, Map.Map n Int)
doRename :: Rename n a -> a
doRename rename = evalState rename (0, Map.empty)
getName :: (Ord n) => n -> Rename n Int
getName thing = do
(i, names) <- get
case names Map.!? thing of
Just name -> pure name
Nothing -> i <$ put (i + 1, Map.insert thing i names)
renameSet :: (Ord v2) => (v1 -> Rename n v2) -> Set.Set v1 -> Rename n (Set.Set v2)
renameSet renameFunc s = Set.fromList <$> (mapM renameFunc $ Set.toList s)
renameMap :: (Ord k2)
=> ((k1, v1) -> Rename n (k2, v2))
-> Map.Map k1 v1
-> Rename n (Map.Map k2 v2)
renameMap f m = Map.fromList <$> (mapM f $ Map.assocs m)
renameKeys :: (Ord k2) => (k1 -> Rename n k2) -> Map.Map k1 v -> Rename n (Map.Map k2 v)
renameKeys f = renameMap (\(k, v) -> (,v) <$> f k)
renameValues :: (Ord k) => (v1 -> Rename n v2) -> Map.Map k v1 -> Rename n (Map.Map k v2)
renameValues f = renameMap (\(k, v) -> (k,) <$> f v)
fromMonoidalList :: (Monoid m, Ord k) => [(k, m)] -> Map.Map k m
fromMonoidalList = foldl' insertMonoidal Map.empty
where
insertMonoidal :: (Monoid v, Ord k) => Map.Map k v -> (k, v) -> Map.Map k v
insertMonoidal m (k, v) = Map.insertWith mappend k v m
groupByFirst :: (Ord a, Ord b) => [(a, b)] -> Map.Map a (Set.Set b)
groupByFirst pairs =
let prepared = map (\(a, b) -> (a, Set.singleton b)) pairs
in fromMonoidalList prepared
groupByFirst = Map.fromListWith mappend . map (\(a, b) -> (a, Set.singleton b))