git.iko.soy/patch
on 00495af 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 as Map
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