Clean up util
This commit is contained in:
parent
2a60939aee
commit
8b5444f585
1 changed files with 1 additions and 46 deletions
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue