{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Data.Patch.MapWithMove
( PatchMapWithMove
( PatchMapWithMove
, unPatchMapWithMove
, ..
)
, patchMapWithMove
, patchMapWithMoveInsertAll
, insertMapKey
, moveMapKey
, swapMapKey
, deleteMapKey
, unsafePatchMapWithMove
, patchMapWithMoveNewElements
, patchMapWithMoveNewElementsMap
, patchThatSortsMapWith
, patchThatChangesAndSortsMapWith
, patchThatChangesMap
, NodeInfo
( NodeInfo
, _nodeInfo_to
, _nodeInfo_from
, ..
)
, bitraverseNodeInfo
, nodeInfoMapFrom
, nodeInfoMapMFrom
, nodeInfoSetTo
, From
( From_Insert
, From_Delete
, From_Move
, ..
)
, bitraverseFrom
, To
) where
import Data.Coerce
import Data.Kind (Type)
import Data.Patch.Class
import Data.Patch.MapWithPatchingMove (PatchMapWithPatchingMove(..), To)
import qualified Data.Patch.MapWithPatchingMove as PM
import Control.Lens
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Proxy
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup (..))
#endif
import Data.Traversable (foldMapDefault)
newtype PatchMapWithMove k (v :: Type) = PatchMapWithMove'
{
unPatchMapWithMove' :: PatchMapWithPatchingMove k (Proxy v)
}
deriving ( Show, Read, Eq, Ord
,
#if __GLASGOW_HASKELL__ >= 806
#endif
Semigroup
, 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
unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
pattern PatchMapWithMove { unPatchMapWithMove } = PatchMapWithMove' (PatchMapWithPatchingMove (Coerce unPatchMapWithMove))
_PatchMapWithMove
:: Iso
(PatchMapWithMove k0 v0)
(PatchMapWithMove k1 v1)
(Map k0 (NodeInfo k0 v0))
(Map k1 (NodeInfo k1 v1))
_PatchMapWithMove = iso unPatchMapWithMove PatchMapWithMove
instance Functor (PatchMapWithMove k) where
fmap f = runIdentity . traverse (Identity . f)
instance Foldable (PatchMapWithMove k) where
foldMap = foldMapDefault
instance Traversable (PatchMapWithMove k) where
traverse =
_PatchMapWithMove .
traverse .
traverse
instance FunctorWithIndex k (PatchMapWithMove k)
instance FoldableWithIndex k (PatchMapWithMove k)
instance TraversableWithIndex k (PatchMapWithMove k) where
itraverse = itraversed . Indexed
itraversed =
_PatchMapWithMove .>
itraversed <.
traverse
patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
patchMapWithMove = fmap PatchMapWithMove' . PM.patchMapWithPatchingMove . coerce
patchMapWithMoveInsertAll :: Map k v -> PatchMapWithMove k v
patchMapWithMoveInsertAll = PatchMapWithMove' . PM.patchMapWithPatchingMoveInsertAll
insertMapKey :: k -> v -> PatchMapWithMove k v
insertMapKey k v = PatchMapWithMove' $ PM.insertMapKey k v
moveMapKey :: Ord k => k -> k -> PatchMapWithMove k v
moveMapKey src dst = PatchMapWithMove' $ PM.moveMapKey src dst
swapMapKey :: Ord k => k -> k -> PatchMapWithMove k v
swapMapKey src dst = PatchMapWithMove' $ PM.swapMapKey src dst
deleteMapKey :: k -> PatchMapWithMove k v
deleteMapKey = PatchMapWithMove' . PM.deleteMapKey
unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
unsafePatchMapWithMove = coerce PM.unsafePatchMapWithPatchingMove
instance Ord k => Patch (PatchMapWithMove k v) where
type PatchTarget (PatchMapWithMove k v) = Map k v
apply (PatchMapWithMove' p) = apply p
patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]
patchMapWithMoveNewElements = PM.patchMapWithPatchingMoveNewElements . unPatchMapWithMove'
patchMapWithMoveNewElementsMap :: PatchMapWithMove k v -> Map k v
patchMapWithMoveNewElementsMap = PM.patchMapWithPatchingMoveNewElementsMap . unPatchMapWithMove'
patchThatSortsMapWith :: Ord k => (v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v
patchThatSortsMapWith cmp = PatchMapWithMove' . PM.patchThatSortsMapWith cmp
patchThatChangesAndSortsMapWith :: (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v
patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patchThatChangesMap oldByIndex newByIndex
where newList = Map.toList newByIndexUnsorted
newByIndex = Map.fromList $ zip (fst <$> newList) $ sortBy cmp $ snd <$> newList
patchThatChangesMap :: (Ord k, Ord v) => Map k v -> Map k v -> PatchMapWithMove k v
patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $
PM.patchThatChangesMap oldByIndex newByIndex
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 = bitraverseNodeInfo pure
bitraverseNodeInfo
:: Applicative f
=> (k0 -> f k1)
-> (v0 -> f v1)
-> NodeInfo k0 v0 -> f (NodeInfo k1 v1)
bitraverseNodeInfo fk fv = fmap NodeInfo'
. PM.bitraverseNodeInfo fk (\ ~Proxy -> pure Proxy) fv
. coerce
nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
nodeInfoMapFrom f = coerce $ PM.nodeInfoMapFrom (unFrom' . f . From')
nodeInfoMapMFrom
:: Functor f
=> (From k v -> f (From k v))
-> NodeInfo k v -> f (NodeInfo k v)
nodeInfoMapMFrom f = fmap NodeInfo'
. PM.nodeInfoMapMFrom (fmap unFrom' . f . From')
. coerce
nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
nodeInfoSetTo = coerce . PM.nodeInfoSetTo
newtype From k (v :: Type) = From' { unFrom' :: PM.From k (Proxy v) }
{-# COMPLETE From_Insert, From_Delete, From_Move #-}
pattern From_Insert :: v -> From k v
pattern From_Insert v = From' (PM.From_Insert v)
pattern From_Delete :: From k v
pattern From_Delete = From' PM.From_Delete
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 From'
. PM.bitraverseFrom fk (\ ~Proxy -> pure Proxy) fv
. coerce
makeWrapped ''PatchMapWithMove
makeWrapped ''NodeInfo
makeWrapped ''From