Skip to content

Commit 48e9b3a

Browse files
committed
Fix docs, also replace odd-end PatchOrReplacement function with prisms
1 parent 884c0da commit 48e9b3a

File tree

3 files changed

+50
-29
lines changed

3 files changed

+50
-29
lines changed

src/Data/Functor/Misc.hs

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -61,8 +61,9 @@ import Data.Typeable hiding (Refl)
6161
-- Const2
6262
--------------------------------------------------------------------------------
6363

64-
-- | 'Const2' stores a value of a given type 'k' and ensures that a particular
65-
-- type 'v' is always given for the last type parameter
64+
-- | @'Const2' k v v@ stores a value of a given type @k@ and ensures
65+
-- that a particular type @v@ is always given for the last type
66+
-- parameter
6667
data Const2 :: Type -> x -> x -> Type where
6768
Const2 :: k -> Const2 k v v
6869
deriving (Typeable)
@@ -227,9 +228,10 @@ dsumToEither = \case
227228
-- ComposeMaybe
228229
--------------------------------------------------------------------------------
229230

230-
-- | We can't use @Compose Maybe@ instead of 'ComposeMaybe', because that would
231-
-- make the 'f' parameter have a nominal type role. We need f to be
232-
-- representational so that we can use safe 'coerce'.
231+
-- | We can't use @'Data.Functor.Compose.Compose' 'Maybe'@ instead of @'ComposeMaybe'@,
232+
-- because that would make the @f@ parameter have a nominal type role.
233+
-- We need @f@ to be representational so that we can use safe
234+
-- @'Data.Coerce.coerce'@.
233235
newtype ComposeMaybe f a =
234236
ComposeMaybe { getComposeMaybe :: Maybe (f a) } deriving (Show, Eq, Ord)
235237

src/Data/Patch/MapWithMove.hs

Lines changed: 19 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -111,8 +111,8 @@ pattern Coerce x <- (coerce -> x)
111111

112112
{-# COMPLETE PatchMapWithMove #-}
113113
pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
114-
-- | Extract the representation of the 'PatchMapWithMove' as a map of
115-
-- 'NodeInfo'.
114+
-- | Extract the representation of the t'PatchMapWithMove' as a map of
115+
-- t'NodeInfo'.
116116
unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
117117
pattern PatchMapWithMove { unPatchMapWithMove } = PatchMapWithMove' (PatchMapWithPatchingMove (Coerce unPatchMapWithMove))
118118

@@ -147,27 +147,27 @@ instance L.FoldableWithIndex k (PatchMapWithMove k) where ifoldMap = Data.Fold
147147
instance L.TraversableWithIndex k (PatchMapWithMove k) where itraverse = Data.Traversable.WithIndex.itraverse
148148
#endif
149149

150-
-- | Create a 'PatchMapWithMove', validating it
150+
-- | Create a t'PatchMapWithMove', validating it
151151
patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
152152
patchMapWithMove = fmap PatchMapWithMove' . PM.patchMapWithPatchingMove . coerce
153153

154-
-- | Create a 'PatchMapWithMove' that inserts everything in the given 'Map'
154+
-- | Create a t'PatchMapWithMove' that inserts everything in the given 'Map'
155155
patchMapWithMoveInsertAll :: Map k v -> PatchMapWithMove k v
156156
patchMapWithMoveInsertAll = PatchMapWithMove' . PM.patchMapWithPatchingMoveInsertAll
157157

158-
-- | Make a @'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.
158+
-- | Make a @t'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.
159159
insertMapKey :: k -> v -> PatchMapWithMove k v
160160
insertMapKey k v = PatchMapWithMove' $ PM.insertMapKey k v
161161

162-
-- |Make a @'PatchMapWithMove' k v@ which has the effect of moving the value from the first key @k@ to the second key @k@, equivalent to:
162+
-- |Make a @t'PatchMapWithMove' k v@ which has the effect of moving the value from the first key @k@ to the second key @k@, equivalent to:
163163
--
164164
-- @
165165
-- 'Map.delete' src (maybe map ('Map.insert' dst) (Map.lookup src map))
166166
-- @
167167
moveMapKey :: Ord k => k -> k -> PatchMapWithMove k v
168168
moveMapKey src dst = PatchMapWithMove' $ PM.moveMapKey src dst
169169

170-
-- |Make a @'PatchMapWithMove' k v@ which has the effect of swapping two keys in the mapping, equivalent to:
170+
-- |Make a @t'PatchMapWithMove' k v@ which has the effect of swapping two keys in the mapping, equivalent to:
171171
--
172172
-- @
173173
-- let aMay = Map.lookup a map
@@ -179,13 +179,13 @@ moveMapKey src dst = PatchMapWithMove' $ PM.moveMapKey src dst
179179
swapMapKey :: Ord k => k -> k -> PatchMapWithMove k v
180180
swapMapKey src dst = PatchMapWithMove' $ PM.swapMapKey src dst
181181

182-
-- |Make a @'PatchMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'Map.delete'.
182+
-- |Make a @t'PatchMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'Map.delete'.
183183
deleteMapKey :: k -> PatchMapWithMove k v
184184
deleteMapKey = PatchMapWithMove' . PM.deleteMapKey
185185

186-
-- | Wrap a @'Map' k (NodeInfo k v)@ representing patch changes into a @'PatchMapWithMove' k v@, without checking any invariants.
186+
-- | Wrap a @'Map' k (NodeInfo k v)@ representing patch changes into a @t'PatchMapWithMove' k v@, without checking any invariants.
187187
--
188-
-- __Warning:__ when using this function, you must ensure that the invariants of 'PatchMapWithMove' are preserved; they will not be checked.
188+
-- __Warning:__ when using this function, you must ensure that the invariants of t'PatchMapWithMove' are preserved; they will not be checked.
189189
unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
190190
unsafePatchMapWithMove = coerce PM.unsafePatchMapWithPatchingMove
191191

@@ -198,25 +198,25 @@ instance Ord k => Patch (PatchMapWithMove k v) where
198198
patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]
199199
patchMapWithMoveNewElements = PM.patchMapWithPatchingMoveNewElements . unPatchMapWithMove'
200200

201-
-- | Return a @'Map' k v@ with all the inserts/updates from the given @'PatchMapWithMove' k v@.
201+
-- | Return a @'Map' k v@ with all the inserts/updates from the given @t'PatchMapWithMove' k v@.
202202
patchMapWithMoveNewElementsMap :: PatchMapWithMove k v -> Map k v
203203
patchMapWithMoveNewElementsMap = PM.patchMapWithPatchingMoveNewElementsMap . unPatchMapWithMove'
204204

205-
-- | Create a 'PatchMapWithMove' that, if applied to the given 'Map', will sort
205+
-- | Create a t'PatchMapWithMove' that, if applied to the given 'Map', will sort
206206
-- its values using the given ordering function. The set keys of the 'Map' is
207207
-- not changed.
208208
patchThatSortsMapWith :: Ord k => (v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v
209209
patchThatSortsMapWith cmp = PatchMapWithMove' . PM.patchThatSortsMapWith cmp
210210

211-
-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
211+
-- | Create a t'PatchMapWithMove' that, if applied to the first 'Map' provided,
212212
-- will produce a 'Map' with the same values as the second 'Map' but with the
213213
-- values sorted with the given ordering function.
214214
patchThatChangesAndSortsMapWith :: (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v
215215
patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patchThatChangesMap oldByIndex newByIndex
216216
where newList = Map.toList newByIndexUnsorted
217217
newByIndex = Map.fromList $ zip (fst <$> newList) $ sortBy cmp $ snd <$> newList
218218

219-
-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
219+
-- | Create a t'PatchMapWithMove' that, if applied to the first 'Map' provided,
220220
-- will produce the second 'Map'.
221221
patchThatChangesMap :: (Ord k, Ord v) => Map k v -> Map k v -> PatchMapWithMove k v
222222
patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $
@@ -262,6 +262,7 @@ instance Foldable (NodeInfo k) where
262262
instance Traversable (NodeInfo k) where
263263
traverse = bitraverseNodeInfo pure
264264

265+
-- | Like 'Data.Bitraversable.bitraverse'
265266
bitraverseNodeInfo
266267
:: Applicative f
267268
=> (k0 -> f k1)
@@ -271,11 +272,11 @@ bitraverseNodeInfo fk fv = fmap NodeInfo'
271272
. PM.bitraverseNodeInfo fk (\ ~Proxy -> pure Proxy) fv
272273
. coerce
273274

274-
-- | Change the 'From' value of a 'NodeInfo'
275+
-- | Change the 'From' value of a t'NodeInfo'
275276
nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
276277
nodeInfoMapFrom f = coerce $ PM.nodeInfoMapFrom (unFrom' . f . From')
277278

278-
-- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
279+
-- | Change the 'From' value of a t'NodeInfo', using a 'Functor' (or
279280
-- 'Applicative', 'Monad', etc.) action to get the new value
280281
nodeInfoMapMFrom
281282
:: Functor f
@@ -285,7 +286,7 @@ nodeInfoMapMFrom f = fmap NodeInfo'
285286
. PM.nodeInfoMapMFrom (fmap unFrom' . f . From')
286287
. coerce
287288

288-
-- | Set the 'To' field of a 'NodeInfo'
289+
-- | Set the 'To' field of a t'NodeInfo'
289290
nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
290291
nodeInfoSetTo = coerce . PM.nodeInfoSetTo
291292

@@ -310,6 +311,7 @@ pattern From_Delete = From' PM.From_Delete
310311
pattern From_Move :: k -> From k v
311312
pattern From_Move k = From' (PM.From_Move k Proxy)
312313

314+
-- | Like 'Data.Bitraversable.bitraverse'
313315
bitraverseFrom
314316
:: Applicative f
315317
=> (k0 -> f k1)

src/Data/Patch/PatchOrReplacement.hs

Lines changed: 24 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -4,11 +4,21 @@
44
{-# LANGUAGE FlexibleInstances #-}
55
{-# LANGUAGE LambdaCase #-}
66
{-# LANGUAGE StandaloneDeriving #-}
7+
{-# LANGUAGE TemplateHaskell #-}
78
{-# LANGUAGE TypeFamilies #-}
89
{-# LANGUAGE UndecidableInstances #-}
910

10-
module Data.Patch.PatchOrReplacement where
11+
{-|
12+
Description: A 'Patch' combinator type for patching or replacing with a separate new value.
13+
-}
14+
module Data.Patch.PatchOrReplacement
15+
( PatchOrReplacement (..)
16+
, _PatchOrReplacement_Patch
17+
, _PatchOrReplacement_Replacement
18+
, traversePatchOrReplacement
19+
) where
1120

21+
import Control.Lens.TH (makePrisms)
1222
import Data.Patch
1323
#if !MIN_VERSION_base(4,11,0)
1424
import Data.Semigroup (Semigroup (..))
@@ -34,13 +44,18 @@ deriving instance (Ord p, Ord (PatchTarget p)) => Ord (PatchOrReplacement p)
3444
deriving instance (Show p, Show (PatchTarget p)) => Show (PatchOrReplacement p)
3545
deriving instance (Read p, Read (PatchTarget p)) => Read (PatchOrReplacement p)
3646

37-
completePatchOrReplacement :: PatchOrReplacement p -> Maybe (PatchTarget p)
38-
completePatchOrReplacement = \case
39-
PatchOrReplacement_Replacement t -> Just t
40-
PatchOrReplacement_Patch _ -> Nothing
47+
-- | Traverse a 'PatchOrReplacement' with a function for each case
48+
traversePatchOrReplacement
49+
:: Functor f
50+
=> (a -> f b)
51+
-> (PatchTarget a -> f (PatchTarget b))
52+
-> PatchOrReplacement a -> f (PatchOrReplacement b)
53+
traversePatchOrReplacement f g = \case
54+
PatchOrReplacement_Patch p -> PatchOrReplacement_Patch <$> f p
55+
PatchOrReplacement_Replacement p -> PatchOrReplacement_Replacement <$> g p
4156

42-
-- | To apply a 'PatchOrReplacement p' apply the the underlying 'p' or
43-
-- substitute the replacement 'PatchTarget p'.
57+
-- | To apply a @'PatchOrReplacement' p@ apply the the underlying @p@ or
58+
-- substitute the replacement @'PatchTarget' p@.
4459
instance Patch p => Patch (PatchOrReplacement p) where
4560
type PatchTarget (PatchOrReplacement p) = PatchTarget p
4661
apply = \case
@@ -61,3 +76,5 @@ instance (Semigroup p, Patch p) => Semigroup (PatchOrReplacement p) where
6176
(PatchOrReplacement_Patch a, PatchOrReplacement_Patch b) -> PatchOrReplacement_Patch $ a <> b
6277
(PatchOrReplacement_Patch a, PatchOrReplacement_Replacement b) -> PatchOrReplacement_Replacement $ applyAlways a b
6378
(PatchOrReplacement_Replacement a, _) -> PatchOrReplacement_Replacement a
79+
80+
makePrisms ''PatchOrReplacement

0 commit comments

Comments
 (0)