1
1
mirror of https://github.com/github/semantic.git synced 2024-12-23 06:41:45 +03:00
semantic/src/Patch.hs

96 lines
2.5 KiB
Haskell
Raw Normal View History

{-# LANGUAGE DeriveAnyClass #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module Patch
( Patch(..)
2016-08-04 16:25:18 +03:00
, replacing
, inserting
, deleting
, after
, before
2017-01-24 23:58:17 +03:00
, afterOrBefore
, unPatch
, patchSum
, maybeFst
, maybeSnd
2016-08-08 21:19:47 +03:00
, mapPatch
2017-01-25 00:00:25 +03:00
, patchType
) where
2015-11-18 05:23:53 +03:00
import Data.Functor.Listable
import Data.These
import Prologue
2016-03-02 22:13:01 +03:00
2016-01-14 19:18:57 +03:00
-- | An operation to replace, insert, or delete an item.
2016-06-30 19:50:52 +03:00
data Patch a
= Replace a a
2015-11-18 05:44:55 +03:00
| Insert a
| Delete a
deriving (Eq, Foldable, Functor, Generic, Ord, Show, Traversable, NFData)
2015-11-20 02:26:40 +03:00
2016-08-04 16:25:18 +03:00
-- DSL
2016-08-04 19:51:05 +03:00
-- | Constructs the replacement of one value by another in an Applicative context.
2016-08-04 16:25:18 +03:00
replacing :: Applicative f => a -> a -> f (Patch a)
replacing = (pure .) . Replace
2016-08-04 19:51:05 +03:00
-- | Constructs the insertion of a value in an Applicative context.
2016-08-04 16:25:18 +03:00
inserting :: Applicative f => a -> f (Patch a)
inserting = pure . Insert
2016-08-04 19:51:05 +03:00
-- | Constructs the deletion of a value in an Applicative context.
2016-08-04 16:25:18 +03:00
deleting :: Applicative f => a -> f (Patch a)
deleting = pure . Delete
2016-01-14 19:18:57 +03:00
-- | Return the item from the after side of the patch.
2015-11-20 02:26:40 +03:00
after :: Patch a -> Maybe a
after = maybeSnd . unPatch
2015-11-20 04:25:28 +03:00
2016-01-14 19:18:57 +03:00
-- | Return the item from the before side of the patch.
2015-11-20 04:25:28 +03:00
before :: Patch a -> Maybe a
before = maybeFst . unPatch
2015-12-01 03:08:28 +03:00
2017-01-24 23:58:17 +03:00
afterOrBefore :: Patch a -> Maybe a
afterOrBefore patch = case (before patch, after patch) of
(_, Just after) -> Just after
(Just before, _) -> Just before
(_, _) -> Nothing
2016-03-02 22:13:01 +03:00
-- | Return both sides of a patch.
2016-03-14 22:40:35 +03:00
unPatch :: Patch a -> These a a
unPatch (Replace a b) = These a b
unPatch (Insert b) = That b
unPatch (Delete a) = This a
2016-03-02 22:13:01 +03:00
2016-08-08 21:19:47 +03:00
mapPatch :: (a -> b) -> (a -> b) -> Patch a -> Patch b
mapPatch f _ (Delete a ) = Delete (f a)
mapPatch _ g (Insert b) = Insert (g b)
mapPatch f g (Replace a b) = Replace (f a) (g b)
2016-01-14 19:18:57 +03:00
-- | Calculate the cost of the patch given a function to compute the cost of a item.
patchSum :: (a -> Int) -> Patch a -> Int
2016-02-23 20:15:06 +03:00
patchSum termCost patch = maybe 0 termCost (before patch) + maybe 0 termCost (after patch)
2016-04-15 04:19:21 +03:00
-- | Return Just the value in This, or the first value in These, if any.
maybeFst :: These a b -> Maybe a
maybeFst = these Just (const Nothing) ((Just .) . const)
-- | Return Just the value in That, or the second value in These, if any.
maybeSnd :: These a b -> Maybe b
maybeSnd = these (const Nothing) Just ((Just .) . flip const)
2017-01-25 00:00:25 +03:00
patchType :: Patch a -> Text
2017-03-28 22:32:45 +03:00
patchType patch = case patch of
Replace{} -> "modified"
2017-01-25 00:00:25 +03:00
Insert{} -> "added"
Delete{} -> "removed"
2017-01-25 00:00:25 +03:00
-- Instances
instance Listable1 Patch where
liftTiers t = liftCons1 t Insert \/ liftCons1 t Delete \/ liftCons2 t t Replace
instance Listable a => Listable (Patch a) where
tiers = tiers1