git.iko.soy/patch
on bc216da help sign in
patch/src/Data/AppendMap.hs
77 lines 2.4 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE DeriveTraversable #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE GeneralizedNewtypeDeriving #-}
8{-# LANGUAGE MultiParamTypeClasses #-}
9{-# LANGUAGE PatternSynonyms #-}
10{-# LANGUAGE RoleAnnotations #-}
11{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE StandaloneDeriving #-}
13{-# LANGUAGE TypeFamilies #-}
14{-# OPTIONS_GHC -fno-warn-orphans #-}
15-- | 'Data.Map' with a better 'Monoid' instance
16--
17-- 'Data.Map' has @mappend = union@, which is left-biased. AppendMap has
18-- @mappend = unionWith mappend@ instead.
19module Data.AppendMap
20 ( module Data.AppendMap
21 , module Data.Map.Monoidal
22 ) where
24import Prelude hiding (map, null)
26import Data.Coerce
27import Data.Default
28import Data.Map (Map)
29import qualified Data.Map.Internal.Debug as Map (showTree, showTreeWith)
30import Data.Map.Monoidal
31import Reflex.Class (FunctorMaybe (..))
32import Reflex.Patch (Additive, Group (..))
34{-# DEPRECATED AppendMap "Use 'MonoidalMap' instead" #-}
35type AppendMap = MonoidalMap
37{-# DEPRECATED _unAppendMap "Use 'getMonoidalMap' instead" #-}
38_unAppendMap :: MonoidalMap k v -> Map k v
39_unAppendMap = getMonoidalMap
41pattern AppendMap :: Map k v -> MonoidalMap k v
42pattern AppendMap m = MonoidalMap m
44instance FunctorMaybe (MonoidalMap k) where
45 fmapMaybe = mapMaybe
47-- | Deletes a key, returning 'Nothing' if the result is empty.
48nonEmptyDelete :: Ord k => k -> MonoidalMap k a -> Maybe (MonoidalMap k a)
49nonEmptyDelete k vs =
50 let deleted = delete k vs
51 in if null deleted
52 then Nothing
53 else Just deleted
55mapMaybeNoNull :: (a -> Maybe b)
56 -> MonoidalMap token a
57 -> Maybe (MonoidalMap token b)
58mapMaybeNoNull f as =
59 let bs = fmapMaybe f as
60 in if null bs
61 then Nothing
62 else Just bs
64-- TODO: Move instances to `Reflex.Patch`
65instance (Ord k, Group q) => Group (MonoidalMap k q) where
66 negateG = map negateG
68instance (Ord k, Additive q) => Additive (MonoidalMap k q)
70showTree :: forall k a. (Show k, Show a) => MonoidalMap k a -> String
71showTree = coerce (Map.showTree :: Map k a -> String)
73showTreeWith :: forall k a. (k -> a -> String) -> Bool -> Bool -> MonoidalMap k a -> String
74showTreeWith = coerce (Map.showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String)
76instance Default (MonoidalMap k a) where
77 def = empty