[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, revert-408-bugfix_394: Rename merge modules (cc0904d)
git at git.haskell.org
git at git.haskell.org
Mon Apr 17 21:45:38 UTC 2017
Repository : ssh://git@git.haskell.org/containers
On branches: cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,revert-408-bugfix_394
Link : http://git.haskell.org/packages/containers.git/commitdiff/cc0904da428ceca2991cad2aa072a19a558ddd09
>---------------------------------------------------------------
commit cc0904da428ceca2991cad2aa072a19a558ddd09
Author: David Feuer <David.Feuer at gmail.com>
Date: Mon Sep 5 14:43:29 2016 -0400
Rename merge modules
I think it's more consistent with the rest of the API to name
them `Data.Map.Merge.Lazy` and `Data.Map.Merge.Strict`. This also
gives us the option to add further merge-related modules in the
`Merge` hierarchy. The original names still work for now, but they
are deprecated and hidden from Haddock.
>---------------------------------------------------------------
cc0904da428ceca2991cad2aa072a19a558ddd09
Data/Map/Lazy/Merge.hs | 73 ++-------------------------
Data/Map/{Lazy/Merge.hs => Merge/Lazy.hs} | 4 +-
Data/Map/{Strict/Merge.hs => Merge/Strict.hs} | 4 +-
Data/Map/Strict/Merge.hs | 69 ++-----------------------
containers.cabal | 2 +
tests/map-properties.hs | 4 +-
6 files changed, 18 insertions(+), 138 deletions(-)
diff --git a/Data/Map/Lazy/Merge.hs b/Data/Map/Lazy/Merge.hs
index 4d54014..603697c 100644
--- a/Data/Map/Lazy/Merge.hs
+++ b/Data/Map/Lazy/Merge.hs
@@ -1,23 +1,12 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE BangPatterns #-}
-#if __GLASGOW_HASKELL__
-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
-#endif
#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703
{-# LANGUAGE Safe #-}
#endif
-#if __GLASGOW_HASKELL__ >= 708
-{-# LANGUAGE RoleAnnotations #-}
-{-# LANGUAGE TypeFamilies #-}
-#define USE_MAGIC_PROXY 1
-#endif
-
-#if USE_MAGIC_PROXY
-{-# LANGUAGE MagicHash #-}
-#endif
#include "containers.h"
+{-# OPTIONS_HADDOCK hide #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Data.Map.Lazy.Merge
@@ -45,59 +34,7 @@
-- inefficient in many cases and should usually be avoided. The instances
-- for 'WhenMatched' tactics should not pose any major efficiency problems.
-module Data.Map.Lazy.Merge (
- -- ** Simple merge tactic types
- SimpleWhenMissing
- , SimpleWhenMatched
-
- -- ** General combining function
- , merge
-
- -- *** @WhenMatched@ tactics
- , zipWithMaybeMatched
- , zipWithMatched
-
- -- *** @WhenMissing@ tactics
- , mapMaybeMissing
- , dropMissing
- , preserveMissing
- , mapMissing
- , filterMissing
-
- -- ** Applicative merge tactic types
- , WhenMissing
- , WhenMatched
-
- -- ** Applicative general combining function
- , mergeA
-
- -- *** @WhenMatched@ tactics
- -- | The tactics described for 'merge' work for
- -- 'mergeA' as well. Furthermore, the following
- -- are available.
- , zipWithMaybeAMatched
- , zipWithAMatched
-
- -- *** @WhenMissing@ tactics
- -- | The tactics described for 'merge' work for
- -- 'mergeA' as well. Furthermore, the following
- -- are available.
- , traverseMaybeMissing
- , traverseMissing
- , filterAMissing
-
- -- *** Covariant maps for tactics
- , mapWhenMissing
- , mapWhenMatched
-
- -- *** Contravariant maps for tactics
- , lmapWhenMissing
- , contramapFirstWhenMatched
- , contramapSecondWhenMatched
-
- -- *** Miscellaneous tactic functions
- , runWhenMatched
- , runWhenMissing
- ) where
+module Data.Map.Lazy.Merge {-# DEPRECATED "Use \"Data.Map.Merge.Lazy\"." #-}
+ ( module Data.Map.Merge.Lazy ) where
-import Data.Map.Internal
+import Data.Map.Merge.Lazy
diff --git a/Data/Map/Lazy/Merge.hs b/Data/Map/Merge/Lazy.hs
similarity index 97%
copy from Data/Map/Lazy/Merge.hs
copy to Data/Map/Merge/Lazy.hs
index 4d54014..ae4f139 100644
--- a/Data/Map/Lazy/Merge.hs
+++ b/Data/Map/Merge/Lazy.hs
@@ -20,7 +20,7 @@
-----------------------------------------------------------------------------
-- |
--- Module : Data.Map.Lazy.Merge
+-- Module : Data.Map.Merge.Lazy
-- Copyright : (c) David Feuer 2016
-- License : BSD-style
-- Maintainer : libraries at haskell.org
@@ -45,7 +45,7 @@
-- inefficient in many cases and should usually be avoided. The instances
-- for 'WhenMatched' tactics should not pose any major efficiency problems.
-module Data.Map.Lazy.Merge (
+module Data.Map.Merge.Lazy (
-- ** Simple merge tactic types
SimpleWhenMissing
, SimpleWhenMatched
diff --git a/Data/Map/Strict/Merge.hs b/Data/Map/Merge/Strict.hs
similarity index 97%
copy from Data/Map/Strict/Merge.hs
copy to Data/Map/Merge/Strict.hs
index f71447e..6fcfaf8 100644
--- a/Data/Map/Strict/Merge.hs
+++ b/Data/Map/Merge/Strict.hs
@@ -20,7 +20,7 @@
-----------------------------------------------------------------------------
-- |
--- Module : Data.Map.Strict.Merge
+-- Module : Data.Map.Merge.Strict
-- Copyright : (c) David Feuer 2016
-- License : BSD-style
-- Maintainer : libraries at haskell.org
@@ -45,7 +45,7 @@
-- inefficient in many cases and should usually be avoided. The instances
-- for 'WhenMatched' tactics should not pose any major efficiency problems.
-module Data.Map.Strict.Merge (
+module Data.Map.Merge.Strict (
-- ** Simple merge tactic types
SimpleWhenMissing
, SimpleWhenMatched
diff --git a/Data/Map/Strict/Merge.hs b/Data/Map/Strict/Merge.hs
index f71447e..73d4c5e 100644
--- a/Data/Map/Strict/Merge.hs
+++ b/Data/Map/Strict/Merge.hs
@@ -1,23 +1,12 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE BangPatterns #-}
-#if __GLASGOW_HASKELL__
-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
-#endif
#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703
{-# LANGUAGE Safe #-}
#endif
-#if __GLASGOW_HASKELL__ >= 708
-{-# LANGUAGE RoleAnnotations #-}
-{-# LANGUAGE TypeFamilies #-}
-#define USE_MAGIC_PROXY 1
-#endif
-
-#if USE_MAGIC_PROXY
-{-# LANGUAGE MagicHash #-}
-#endif
#include "containers.h"
+{-# OPTIONS_HADDOCK hide #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Data.Map.Strict.Merge
@@ -45,55 +34,7 @@
-- inefficient in many cases and should usually be avoided. The instances
-- for 'WhenMatched' tactics should not pose any major efficiency problems.
-module Data.Map.Strict.Merge (
- -- ** Simple merge tactic types
- SimpleWhenMissing
- , SimpleWhenMatched
-
- -- ** General combining function
- , merge
-
- -- *** @WhenMatched@ tactics
- , zipWithMaybeMatched
- , zipWithMatched
-
- -- *** @WhenMissing@ tactics
- , mapMaybeMissing
- , dropMissing
- , preserveMissing
- , mapMissing
- , filterMissing
-
- -- ** Applicative merge tactic types
- , WhenMissing
- , WhenMatched
-
- -- ** Applicative general combining function
- , mergeA
-
- -- *** @WhenMatched@ tactics
- -- | The tactics described for 'merge' work for
- -- 'mergeA' as well. Furthermore, the following
- -- are available.
- , zipWithMaybeAMatched
- , zipWithAMatched
-
- -- *** @WhenMissing@ tactics
- -- | The tactics described for 'merge' work for
- -- 'mergeA' as well. Furthermore, the following
- -- are available.
- , traverseMaybeMissing
- , traverseMissing
- , filterAMissing
-
- -- ** Covariant maps for tactics
- , mapWhenMissing
- , mapWhenMatched
-
- -- ** Miscellaneous functions on tactics
-
- , runWhenMatched
- , runWhenMissing
- ) where
+module Data.Map.Strict.Merge {-# DEPRECATED "Use \"Data.Map.Merge.Strict\"." #-}
+ ( module Data.Map.Merge.Strict ) where
-import Data.Map.Strict.Internal
+import Data.Map.Merge.Strict
diff --git a/containers.cabal b/containers.cabal
index b8ab295..6671ebf 100644
--- a/containers.cabal
+++ b/containers.cabal
@@ -50,9 +50,11 @@ Library
Data.Map
Data.Map.Lazy
Data.Map.Lazy.Merge
+ Data.Map.Merge.Lazy
Data.Map.Strict.Internal
Data.Map.Strict
Data.Map.Strict.Merge
+ Data.Map.Merge.Strict
Data.Map.Internal
Data.Map.Internal.Debug
Data.Set.Internal
diff --git a/tests/map-properties.hs b/tests/map-properties.hs
index 5647292..703f88f 100644
--- a/tests/map-properties.hs
+++ b/tests/map-properties.hs
@@ -2,10 +2,10 @@
#ifdef STRICT
import Data.Map.Strict as Data.Map hiding (showTree, showTreeWith)
-import Data.Map.Strict.Merge
+import Data.Map.Merge.Strict
#else
import Data.Map.Lazy as Data.Map hiding (showTree, showTreeWith)
-import Data.Map.Lazy.Merge
+import Data.Map.Merge.Lazy
#endif
import Data.Map.Internal (Map (..), link2, link, bin)
import Data.Map.Internal.Debug (showTree, showTreeWith, balanced)
More information about the ghc-commits
mailing list