dependent-monoidal-map 0.1.0.0 → 0.1.1.0
raw patch · 4 files changed
+108/−45 lines, 4 filesdep ~aesondep ~basedep ~constraintssetup-changed
Dependency ranges changed: aeson, base, constraints, constraints-extras, dependent-map, dependent-sum, dependent-sum-aeson-orphans
Files
- ChangeLog.md +0/−4
- Setup.hs +0/−2
- dependent-monoidal-map.cabal +18/−10
- src/Data/Dependent/Map/Monoidal.hs +90/−29
ChangeLog.md view
@@ -1,5 +1,1 @@ # Revision history for dependent-monoidal-map--## 0.1.0.0 -- YYYY-mm-dd--* First version. Released on an unsuspecting world.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
dependent-monoidal-map.cabal view
@@ -1,6 +1,6 @@ name: dependent-monoidal-map-version: 0.1.0.0-synopsis: Data.Dependent.Map variant that appends conflicting entries when merging maps instead of discarding one side of the conflict.+version: 0.1.1.0+description: Data.Dependent.Map variant that appends conflicting entries when merging maps instead of discarding one side of the conflict. license: BSD3 license-file: LICENSE author: Obsidian Systems LLC@@ -9,16 +9,24 @@ build-type: Simple extra-source-files: ChangeLog.md cabal-version: >=1.10+category: Data+synopsis: Dependent map that uses semigroup mappend +tested-with:+ GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5+ library exposed-modules: Data.Dependent.Map.Monoidal- -- other-modules: - build-depends: base >=4.9 && <4.11- , aeson- , constraints- , constraints-extras- , dependent-sum- , dependent-sum-aeson-orphans- , dependent-map+ build-depends: base >=4.9 && <4.13,+ aeson >= 1.4.4 && < 1.5,+ constraints >= 0.10.1 && < 0.11,+ constraints-extras >= 0.3.0 && < 0.4,+ dependent-map >= 0.3 && < 0.4,+ dependent-sum >= 0.6.2 && < 0.7,+ dependent-sum-aeson-orphans >= 0.2.1 && < 0.3 hs-source-dirs: src default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/obsidiansystems/dependent-monoidal-map
src/Data/Dependent/Map/Monoidal.hs view
@@ -5,12 +5,14 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE GADTs #-} module Data.Dependent.Map.Monoidal where import Data.Aeson import Data.Coerce-import Data.Constraint import Data.Constraint.Extras import Data.Constraint.Forall import Data.Dependent.Map (DMap)@@ -18,24 +20,83 @@ import Data.Dependent.Sum import Data.Dependent.Sum.Orphans () import Data.GADT.Compare+import Data.GADT.Show import Data.Maybe import Data.Semigroup import Data.Some hiding (This)+import Text.Read import Prelude hiding (lookup, map) -newtype MonoidalDMap f g = MonoidalDMap { unMonoidalDMap :: DMap f g }- deriving (Eq, Ord, Read, Show)+newtype MonoidalDMap (f :: k -> *) (g :: k -> *) = MonoidalDMap { unMonoidalDMap :: DMap f g } -deriving instance (ForallF ToJSON f, Has ToJSON f, ToJSON1 g) => ToJSON (MonoidalDMap f g)+-- Temporary shim to avoid making changes to dependent-sum and dependent-map.+-- TODO: Finalise constraints-extras and optionally get it upstreamed into constraints.+-- Then actually get these instances into the real DSum and DMap,+-- killing off EqTag, OrdTag, ShowTag and ReadTag.+newtype FakeDSum f g = FakeDSum { unFakeDSum :: DSum f g } -instance (ForallF Semigroup g, GCompare f) => Semigroup (MonoidalDMap f g) where- (MonoidalDMap m) <> (MonoidalDMap n) = MonoidalDMap (DMap.unionWithKey (\_ (u :: g a) v -> (u <> v) \\ (instF :: ForallF Semigroup g :- Semigroup (g a))) m n)+instance (GEq f, Has' Eq f g) => Eq (FakeDSum f g) where+ FakeDSum ((k :: k a) :=> v) == FakeDSum (k' :=> v') = case geq k k' of+ Nothing -> False+ Just Refl -> has' @Eq @g k (v == v') -instance (ForallF Monoid g, GCompare f) => Monoid (MonoidalDMap f g) where+instance (GCompare f, Has' Eq f g, Has' Ord f g) => Ord (FakeDSum f g) where+ compare (FakeDSum (k :=> v)) (FakeDSum (k' :=> v')) = case gcompare k k' of+ GLT -> LT+ GGT -> GT+ GEQ -> has' @Ord @g k (compare v v')++-- NB: We're not going to show/parse the "FakeDSum" constructor, because this whole datatype is a temporary shim.+instance (ForallF Show f, Has' Show f g) => Show (FakeDSum f g) where+ showsPrec p (FakeDSum ((k :: f a) :=> v)) = showParen (p >= 10)+ ( whichever @Show @f @a (showsPrec 0 k)+ . showString " :=> "+ . has' @Show @g k (showsPrec 1 v)+ )++instance (GRead f, Has' Read f g) => Read (FakeDSum f g) where+ readsPrec p = readParen (p > 1) $ \s ->+ concat+ [ getGReadResult withTag $ \tag ->+ [ (FakeDSum (tag :=> val), rest'')+ | (val, rest'') <- has' @Read @g tag $ readsPrec 1 rest'+ ]+ | (withTag, rest) <- greadsPrec p s+ , (":=>", rest') <- lex rest+ ]++instance forall f g. (Has' Eq f g, GCompare f) => Eq (MonoidalDMap f g) where+ MonoidalDMap m == MonoidalDMap m' =+ (coerce (DMap.toList m) :: [FakeDSum f g]) == (coerce (DMap.toList m'))++instance forall f g. (Has' Eq f g, Has' Ord f g, GCompare f) => Ord (MonoidalDMap f g) where+ compare (MonoidalDMap m) (MonoidalDMap m') =+ compare (coerce (DMap.toList m) :: [FakeDSum f g]) (coerce (DMap.toList m'))++instance (Show (FakeDSum k f)) => Show (MonoidalDMap k f) where+ showsPrec p m = showParen (p>10)+ ( showString "fromList "+ . showsPrec 11 (coerce (toList m) :: [FakeDSum k f])+ )++instance (GCompare k, Read (FakeDSum k f)) => Read (MonoidalDMap k f) where+ readPrec = parens $ prec 10 $ do+ Ident "fromList" <- lexP+ xs <- readPrec+ return . MonoidalDMap . DMap.fromList $ coerce (xs :: [FakeDSum k f])+ readListPrec = readListPrecDefault++deriving instance (ToJSON (DMap f g)) => ToJSON (MonoidalDMap f g)++instance (Has' Semigroup f g, GCompare f) => Semigroup (MonoidalDMap f g) where+ (MonoidalDMap m) <> (MonoidalDMap n) =+ MonoidalDMap (DMap.unionWithKey (\f (u :: g a) v -> has' @Semigroup @g f (u <> v)) m n)++instance (Has' Semigroup f g, GCompare f) => Monoid (MonoidalDMap f g) where mempty = empty- mappend (MonoidalDMap m) (MonoidalDMap n) = MonoidalDMap (DMap.unionWithKey (\_ (u :: g a) v -> mappend u v \\ (instF :: ForallF Monoid g :- Monoid (g a))) m n)+ mappend m n = m <> n -deriving instance (FromJSON (Some f), GCompare f, Has FromJSON f, FromJSON1 g) => FromJSON (MonoidalDMap f g)+deriving instance (FromJSON (DMap f g)) => FromJSON (MonoidalDMap f g) {-------------------------------------------------------------------- Construction@@ -77,7 +138,7 @@ -- | /O(log n)/. Delete and find the minimal element. ----- > deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((3,"b"), fromList[(5,"a"), (10,"c")]) +-- > deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((3,"b"), fromList[(5,"a"), (10,"c")]) -- > deleteFindMin Error: can not return the minimal element of an empty map deleteFindMin :: MonoidalDMap k f -> (DSum k f, MonoidalDMap k f)@@ -151,7 +212,7 @@ insert k v (MonoidalDMap m) = MonoidalDMap (DMap.insert k v m) -- | /O(log n)/. Insert with a function, combining new value and old value.--- @'insertWith' f key value mp@ +-- @'insertWith' f key value mp@ -- will insert the entry @key :=> value@ into @mp@ if key does -- not exist in the map. If the key does exist, the function will -- insert the entry @key :=> f new_value old_value@.@@ -164,7 +225,7 @@ insertWith' f k v (MonoidalDMap m) = MonoidalDMap (DMap.insertWith' f k v m) -- | /O(log n)/. Insert with a function, combining key, new value and old value.--- @'insertWithKey' f key value mp@ +-- @'insertWithKey' f key value mp@ -- will insert the entry @key :=> value@ into @mp@ if key does -- not exist in the map. If the key does exist, the function will -- insert the entry @key :=> f key new_value old_value@.@@ -234,7 +295,7 @@ -- | /O(log n)/. Lookup and update. See also 'updateWithKey'. -- The function returns changed value, if it is updated.--- Returns the original key value if the map entry is deleted. +-- Returns the original key value if the map entry is deleted. updateLookupWithKey :: forall k f v. GCompare k => (k v -> f v -> Maybe (f v)) -> k v -> MonoidalDMap k f -> (Maybe (f v), MonoidalDMap k f) updateLookupWithKey f k (MonoidalDMap m) = case DMap.updateLookupWithKey f k m of@@ -339,7 +400,7 @@ Difference --------------------------------------------------------------------} --- | /O(m * log (n\/m + 1)), m <= n/. Difference of two maps. +-- | /O(m * log (n\/m + 1)), m <= n/. Difference of two maps. -- Return elements of the first map not existing in the second map. difference :: GCompare k => MonoidalDMap k f -> MonoidalDMap k g -> MonoidalDMap k f difference (MonoidalDMap m) (MonoidalDMap n) = MonoidalDMap (DMap.difference m n)@@ -347,7 +408,7 @@ -- | /O(n+m)/. Difference with a combining function. When two equal keys are -- encountered, the combining function is applied to the key and both values. -- If it returns 'Nothing', the element is discarded (proper set difference). If--- it returns (@'Just' y@), the element is updated with a new value @y@. +-- it returns (@'Just' y@), the element is updated with a new value @y@. differenceWithKey :: GCompare k => (forall v. k v -> f v -> g v -> Maybe (f v)) -> MonoidalDMap k f -> MonoidalDMap k g -> MonoidalDMap k f differenceWithKey f (MonoidalDMap m) (MonoidalDMap n) = MonoidalDMap (DMap.differenceWithKey f m n) @@ -365,7 +426,7 @@ -- | /O(n+m)/. -- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' 'eqTagged')@). ---isSubmapOf :: (GCompare k, EqTag k f) => MonoidalDMap k f -> MonoidalDMap k f -> Bool+isSubmapOf :: (GCompare k, Has' Eq k f) => MonoidalDMap k f -> MonoidalDMap k f -> Bool isSubmapOf (MonoidalDMap m) (MonoidalDMap n) = DMap.isSubmapOf m n {- | /O(n+m)/.@@ -376,16 +437,16 @@ isSubmapOfBy :: GCompare k => (forall v. k v -> k v -> f v -> g v -> Bool) -> MonoidalDMap k f -> MonoidalDMap k g -> Bool isSubmapOfBy f (MonoidalDMap m) (MonoidalDMap n) = DMap.isSubmapOfBy f m n --- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). +-- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' 'eqTagged'@).-isProperSubmapOf :: (GCompare k, EqTag k f) => MonoidalDMap k f -> MonoidalDMap k f -> Bool+isProperSubmapOf :: (GCompare k, Has' Eq k f) => MonoidalDMap k f -> MonoidalDMap k f -> Bool isProperSubmapOf (MonoidalDMap m) (MonoidalDMap n) = DMap.isProperSubmapOf m n {- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when @m1@ and @m2@ are not equal, all keys in @m1@ are in @m2@, and when @f@ returns 'True' when- applied to their respective keys and values. + applied to their respective keys and values. -} isProperSubmapOfBy :: GCompare k => (forall v. k v -> k v -> f v -> g v -> Bool) -> MonoidalDMap k f -> MonoidalDMap k g -> Bool isProperSubmapOfBy f (MonoidalDMap m) (MonoidalDMap n) = DMap.isProperSubmapOfBy f m n@@ -452,7 +513,7 @@ -- | /O(n*log n)/. -- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.--- +-- -- The size of the result may be smaller if @f@ maps two or more distinct -- keys to the same new key. In this case the associated values will be -- combined using @c@.@@ -465,8 +526,8 @@ -- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@. -- /The precondition is not checked./ -- Semi-formally, we have:--- --- > and [x < y ==> f x < f y | x <- ls, y <- ls] +--+-- > and [x < y ==> f x < f y | x <- ls, y <- ls] -- > ==> mapKeysMonotonic f s == mapKeys f s -- > where ls = keys s --@@ -476,7 +537,7 @@ mapKeysMonotonic f (MonoidalDMap m) = MonoidalDMap (DMap.mapKeysMonotonic f m) {--------------------------------------------------------------------- Folds + Folds --------------------------------------------------------------------} -- | /O(n)/. Post-order fold. The function will be applied from the lowest@@ -490,7 +551,7 @@ foldlWithKey f x (MonoidalDMap m) = DMap.foldlWithKey f x m {--------------------------------------------------------------------- List variations + List variations --------------------------------------------------------------------} -- | /O(n)/. Return all keys of the map in ascending order.@@ -506,7 +567,7 @@ assocs (MonoidalDMap m) = DMap.assocs m {--------------------------------------------------------------------- Lists + Lists use [foldlStrict] to reduce demand on the control-stack --------------------------------------------------------------------} @@ -528,8 +589,8 @@ {-------------------------------------------------------------------- Building trees from ascending/descending lists can be done in linear time.- - Note that if [xs] is ascending that: ++ Note that if [xs] is ascending that: fromAscList xs == fromList xs fromAscListWith f xs == fromListWith f xs --------------------------------------------------------------------}@@ -537,7 +598,7 @@ -- | /O(n)/. Build a map from an ascending list in linear time with a -- combining function for equal keys. -- /The precondition (input list is ascending) is not checked./-fromAscListWithKey :: GEq k => (forall v. k v -> f v -> f v -> f v) -> [DSum k f] -> MonoidalDMap k f +fromAscListWithKey :: GEq k => (forall v. k v -> f v -> f v -> f v) -> [DSum k f] -> MonoidalDMap k f fromAscListWithKey f xs = MonoidalDMap (DMap.fromAscListWithKey f xs) {--------------------------------------------------------------------@@ -562,7 +623,7 @@ -- | /O(n)/. Show the tree that implements the map. The tree is shown -- in a compressed, hanging format. See 'showTreeWith'.-showTree :: ShowTag k f => MonoidalDMap k f -> String+showTree :: (GShow k, Has' Show k f) => MonoidalDMap k f -> String showTree (MonoidalDMap m) = DMap.showTree m {- | /O(n)/. The expression (@'showTreeWith' showelem hang wide map@) shows