Cleanup and avoid GHC bugs

- Do explicit export lists. This is a chore now, but makes managing
  Compatibility easier later.

- Make `MapWithMove`'s `From` a proper newtype. This improves the
  compatibility and type error situation.

- Work around GHC export list bug: the explicit export lists without big
  reexports this this for us, in fact.

Author: Ericson2314

ChangeLog.md

@@ -3,8 +3,10 @@
 ## Unreleased
 
 * Rewrite `PatchMapWithMove` in terms of `PatchMapWithPatchingMove`.
-  Care is taken to make this as little of a breaking change as possible.
-  In particular, `PatchMapWithMove` is a newtype of `PatchMapWithPatchingMove` as is the `NodeInfo` of `PatchMapWithPatchingMove`'s `NodeInfo`.
+  Care is taken to make this not a breaking change.
+  In particular, `PatchMapWithMove` is a newtype of `PatchMapWithPatchingMove`, as is the `NodeInfo` and `From` of `PatchMapWithPatchingMove`'s versions of those.
+  There are complete constructor and field patterns too, and everything is
+  exported under the newtype as real constructors and fields would be.
 
 ## 0.0.4.0
 

src/Data/Patch/Class.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 -- | The interface for types which represent changes made to other types
 module Data.Patch.Class where
 
 import Data.Functor.Identity
+import Data.Kind (Type)
 import Data.Maybe
 #if !MIN_VERSION_base(4,11,0)
 import Data.Semigroup (Semigroup(..))
@@ -15,7 +17,7 @@ import Data.Proxy
 -- If an instance of 'Patch' is also an instance of 'Semigroup', it should obey
 -- the law that @applyAlways (f <> g) == applyAlways f . applyAlways g@.
 class Patch p where
-  type PatchTarget p :: *
+  type PatchTarget p :: Type
   -- | Apply the patch @p a@ to the value @a@.  If no change is needed, return
   -- 'Nothing'.
   apply :: p -> PatchTarget p -> Maybe (PatchTarget p)
@@ -30,7 +32,7 @@ instance Patch (Identity a) where
   apply (Identity a) _ = Just a
 
 -- | 'Proxy' can be used as a 'Patch' that does nothing.
-instance Patch (Proxy (a :: *)) where
+instance forall (a :: Type). Patch (Proxy a) where
   type PatchTarget (Proxy a) = a
   apply ~Proxy _ = Nothing
 

src/Data/Patch/MapWithMove.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -16,30 +17,59 @@
 -- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
 -- another
 module Data.Patch.MapWithMove
-  ( module Data.Patch.MapWithMove
-  , PatchMapWithMove
+  ( PatchMapWithMove
     ( PatchMapWithMove
     , -- | Extract the representation of the 'PatchMapWithMove' as a map of
       -- 'NodeInfo'.
       unPatchMapWithMove
     , ..
     )
+  , patchMapWithMove
+  , patchMapWithMoveInsertAll
+  , insertMapKey
+  , moveMapKey
+  , swapMapKey
+  , deleteMapKey
+  , unsafePatchMapWithMove
+  , patchMapWithMoveNewElements
+  , patchMapWithMoveNewElementsMap
+  , patchThatSortsMapWith
+  , patchThatChangesAndSortsMapWith
+  , patchThatChangesMap
+
+  -- * Node Info
   , NodeInfo
     ( NodeInfo
     , _nodeInfo_to
     , _nodeInfo_from
     , ..
     )
-  -- TODO export these under the type consructor once GHC is fixed
-  -- , From (From_Insert, From_Delete, From_Move)
+  , bitraverseNodeInfo
+  , nodeInfoMapFrom
+  , nodeInfoMapMFrom
+  , nodeInfoSetTo
+
+  -- * From
+  , From
+    ( From_Insert
+    , From_Delete
+    , From_Move
+    , ..
+    )
+  , bitraverseFrom
+
+  -- * To
+  , To
   ) where
 
 import Data.Coerce
+import Data.Kind (Type)
 import Data.Patch.Class
 import Data.Patch.MapWithPatchingMove
   ( PatchMapWithPatchingMove (..)
   )
 import qualified Data.Patch.MapWithPatchingMove as PM
+import Data.Patch.MapWithPatchingMove (To) -- already a transparent synonym
 
 import Control.Lens hiding (from, to)
 import Data.List
@@ -54,7 +84,7 @@ import Data.Traversable (foldMapDefault)
 -- | Patch a Map with additions, deletions, and moves.  Invariant: If key @k1@
 -- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
 -- and vice versa.  There should never be any unpaired From/To keys.
-newtype PatchMapWithMove k v = PatchMapWithMove'
+newtype PatchMapWithMove k (v :: Type) = PatchMapWithMove'
   { -- | Extract the underlying 'PatchMapWithPatchingMove k (Proxy v)'
     unPatchMapWithMove' :: PatchMapWithPatchingMove k (Proxy v)
   }
@@ -66,10 +96,14 @@ newtype PatchMapWithMove k v = PatchMapWithMove'
            , Monoid
            )
 
+pattern Coerce :: Coercible a b => a -> b
+pattern Coerce x <- (coerce -> x)
+  where Coerce x = coerce x
+
 {-# COMPLETE PatchMapWithMove #-}
 pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
-pattern PatchMapWithMove { unPatchMapWithMove } <- PatchMapWithMove' (PatchMapWithPatchingMove (coerce -> unPatchMapWithMove))
-  where PatchMapWithMove m = PatchMapWithMove' $ PatchMapWithPatchingMove $ coerce m
+unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
+pattern PatchMapWithMove { unPatchMapWithMove } = PatchMapWithMove' (PatchMapWithPatchingMove (Coerce unPatchMapWithMove))
 
 _PatchMapWithMove
   :: Iso
@@ -100,55 +134,6 @@ instance TraversableWithIndex k (PatchMapWithMove k) where
     itraversed <.
     traverse
 
-newtype NodeInfo k v = NodeInfo' { unNodeInfo' :: PM.NodeInfo k (Proxy v) }
-  deriving ( Show, Read, Eq, Ord
-           )
-
-{-# COMPLETE NodeInfo #-}
-pattern NodeInfo :: To k -> From k v -> NodeInfo k v
-pattern NodeInfo { _nodeInfo_to, _nodeInfo_from } =
-  NodeInfo' (PM.NodeInfo
-    { PM._nodeInfo_to = _nodeInfo_to
-    , PM._nodeInfo_from = _nodeInfo_from
-    })
-
-_NodeInfo
-  :: Iso
-       (NodeInfo k0 v0)
-       (NodeInfo k1 v1)
-       (PM.NodeInfo k0 (Proxy v0))
-       (PM.NodeInfo k1 (Proxy v1))
-_NodeInfo = iso unNodeInfo' NodeInfo'
-
-instance Functor (NodeInfo k) where
-  fmap f = runIdentity . traverse (Identity . f)
-
-instance Foldable (NodeInfo k) where
-  foldMap = foldMapDefault
-
-instance Traversable (NodeInfo k) where
-  traverse = _NodeInfo . traverseNodeInfo
-    where
-      traverseNodeInfo
-        :: Traversal (PM.NodeInfo k (Proxy a)) (PM.NodeInfo k (Proxy b)) a b
-      traverseNodeInfo = PM.bitraverseNodeInfo pure (\ ~Proxy -> pure Proxy)
-
-type From k v = PM.From k (Proxy v)
-
-{-# COMPLETE From_Insert, From_Delete, From_Move #-}
-
-pattern From_Insert :: v -> From k v
-pattern From_Insert v = PM.From_Insert v
-
-pattern From_Delete :: From k v
-pattern From_Delete = PM.From_Delete
-
-pattern From_Move :: k -> From k v
-pattern From_Move k = PM.From_Move k Proxy
-
-type To k = PM.To k
-
-
 -- | Create a 'PatchMapWithMove', validating it
 patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
 patchMapWithMove = fmap coerce . PM.patchMapWithPatchingMove . coerce
@@ -224,21 +209,106 @@ patchThatChangesMap :: (Ord k, Ord v) => Map k v -> Map k v -> PatchMapWithMove
 patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $
   PM.patchThatChangesMap oldByIndex newByIndex
 
+--
+-- NodeInfo
+--
+
+-- | Holds the information about each key: where its new value should come from,
+-- and where its old value should go to
+newtype NodeInfo k (v :: Type) = NodeInfo' { unNodeInfo' :: PM.NodeInfo k (Proxy v) }
+
+deriving instance (Show k, Show p) => Show (NodeInfo k p)
+deriving instance (Read k, Read p) => Read (NodeInfo k p)
+deriving instance (Eq k, Eq p) => Eq (NodeInfo k p)
+deriving instance (Ord k, Ord p) => Ord (NodeInfo k p)
+
+{-# COMPLETE NodeInfo #-}
+pattern NodeInfo :: To k -> From k v -> NodeInfo k v
+_nodeInfo_to :: NodeInfo k v -> To k
+_nodeInfo_from :: NodeInfo k v -> From k v
+pattern NodeInfo { _nodeInfo_to, _nodeInfo_from } =
+  NodeInfo' (PM.NodeInfo
+    { PM._nodeInfo_to = _nodeInfo_to
+    , PM._nodeInfo_from = Coerce _nodeInfo_from
+    })
+
+_NodeInfo
+  :: Iso
+       (NodeInfo k0 v0)
+       (NodeInfo k1 v1)
+       (PM.NodeInfo k0 (Proxy v0))
+       (PM.NodeInfo k1 (Proxy v1))
+_NodeInfo = iso unNodeInfo' NodeInfo'
+
+instance Functor (NodeInfo k) where
+  fmap f = runIdentity . traverse (Identity . f)
+
+instance Foldable (NodeInfo k) where
+  foldMap = foldMapDefault
+
+instance Traversable (NodeInfo k) where
+  traverse = _NodeInfo . traverseNodeInfo
+    where
+      traverseNodeInfo
+        :: Traversal (PM.NodeInfo k (Proxy a)) (PM.NodeInfo k (Proxy b)) a b
+      traverseNodeInfo = PM.bitraverseNodeInfo pure (\ ~Proxy -> pure Proxy)
+
+bitraverseNodeInfo
+  :: Applicative f
+  => (k0 -> f k1)
+  -> (v0 -> f v1)
+  -> NodeInfo k0 v0 -> f (NodeInfo k1 v1)
+bitraverseNodeInfo fk fv = fmap coerce
+  . PM.bitraverseNodeInfo fk (\ ~Proxy -> pure Proxy) fv
+  . coerce
+
 -- | Change the 'From' value of a 'NodeInfo'
 nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
-nodeInfoMapFrom = coerce . PM.nodeInfoMapFrom
+nodeInfoMapFrom f = coerce . PM.nodeInfoMapFrom (unFrom' . f . From') . coerce
 
 -- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
 -- 'Applicative', 'Monad', etc.) action to get the new value
 nodeInfoMapMFrom
   :: Functor f
   => (From k v -> f (From k v))
   -> NodeInfo k v -> f (NodeInfo k v)
-nodeInfoMapMFrom f = fmap coerce . PM.nodeInfoMapMFrom f . coerce
+nodeInfoMapMFrom f = fmap coerce
+  . PM.nodeInfoMapMFrom (fmap unFrom' . f . From')
+  . coerce
 
 -- | Set the 'To' field of a 'NodeInfo'
 nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
 nodeInfoSetTo = coerce . PM.nodeInfoSetTo
 
+--
+-- From
+--
+
+-- | Describe how a key's new value should be produced
+newtype From k (v :: Type) = From' { unFrom' :: PM.From k (Proxy v) }
+
+{-# COMPLETE From_Insert, From_Delete, From_Move #-}
+
+-- | Insert the given value here
+pattern From_Insert :: v -> From k v
+pattern From_Insert v = From' (PM.From_Insert v)
+
+-- | Delete the existing value, if any, from here
+pattern From_Delete :: From k v
+pattern From_Delete = From' (PM.From_Delete)
+
+-- | Move the value here from the given key
+pattern From_Move :: k -> From k v
+pattern From_Move k = From' (PM.From_Move k Proxy)
+
+bitraverseFrom
+  :: Applicative f
+  => (k0 -> f k1)
+  -> (v0 -> f v1)
+  -> From k0 v0 -> f (From k1 v1)
+bitraverseFrom fk fv = fmap coerce
+  . PM.bitraverseFrom fk (\ ~Proxy -> pure Proxy) fv
+  . coerce
+
 makeWrapped ''PatchMapWithMove
 makeWrapped ''NodeInfo