on 5e1df2e help sign in
patch/src/Data/AppendMap.hs
81 lines 2.5 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)
29#if MIN_VERSION_containers(0,5,11)
30import qualified Data.Map.Internal.Debug as Map (showTree, showTreeWith)
31#else
32import qualified Data.Map as Map (showTree, showTreeWith)
33#endif
34import Data.Map.Monoidal
35import Reflex.Class (FunctorMaybe (..))
36import Reflex.Patch (Additive, Group (..))
38{-# DEPRECATED AppendMap "Use 'MonoidalMap' instead" #-}
39type AppendMap = MonoidalMap
41{-# DEPRECATED _unAppendMap "Use 'getMonoidalMap' instead" #-}
42_unAppendMap :: MonoidalMap k v -> Map k v
43_unAppendMap = getMonoidalMap
45pattern AppendMap :: Map k v -> MonoidalMap k v
46pattern AppendMap m = MonoidalMap m
48instance FunctorMaybe (MonoidalMap k) where
49 fmapMaybe = mapMaybe
51-- | Deletes a key, returning 'Nothing' if the result is empty.
52nonEmptyDelete :: Ord k => k -> MonoidalMap k a -> Maybe (MonoidalMap k a)
53nonEmptyDelete k vs =
54 let deleted = delete k vs
55 in if null deleted
56 then Nothing
57 else Just deleted
59mapMaybeNoNull :: (a -> Maybe b)
60 -> MonoidalMap token a
61 -> Maybe (MonoidalMap token b)
62mapMaybeNoNull f as =
63 let bs = fmapMaybe f as
64 in if null bs
65 then Nothing
66 else Just bs
68-- TODO: Move instances to `Reflex.Patch`
69instance (Ord k, Group q) => Group (MonoidalMap k q) where
70 negateG = map negateG
72instance (Ord k, Additive q) => Additive (MonoidalMap k q)
74showTree :: forall k a. (Show k, Show a) => MonoidalMap k a -> String
75showTree = coerce (Map.showTree :: Map k a -> String)
77showTreeWith :: forall k a. (k -> a -> String) -> Bool -> Bool -> MonoidalMap k a -> String
78showTreeWith = coerce (Map.showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String)
80instance Default (MonoidalMap k a) where
81 def = empty