{-# LANGUAGE DeriveAnyClass #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module Patch
( Patch(..)
, after
, before
, unPatch
, patchSum
, maybeFst
, maybeSnd
, mapPatch
) where

import Data.Align
import Data.Functor.Classes.Pretty.Generic
import Data.Functor.Listable
import Data.These
import GHC.Generics

-- | An operation to replace, insert, or delete an item.
data Patch a
  = Replace a a
  | Insert a
  | Delete a
  deriving (Eq, Foldable, Functor, Generic, Generic1, Ord, Show, Traversable)


-- | Return the item from the after side of the patch.
after :: Patch a -> Maybe a
after = maybeSnd . unPatch

-- | Return the item from the before side of the patch.
before :: Patch a -> Maybe a
before = maybeFst . unPatch

-- | Return both sides of a patch.
unPatch :: Patch a -> These a a
unPatch (Replace a b) = These a b
unPatch (Insert b) = That b
unPatch (Delete a) = This a

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)

-- | Calculate the cost of the patch given a function to compute the cost of a item.
patchSum :: (a -> Int) -> Patch a -> Int
patchSum termCost patch = maybe 0 termCost (before patch) + maybe 0 termCost (after patch)

-- | 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)


-- 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

instance Crosswalk Patch where
  crosswalk f (Replace a b) = alignWith (these Delete Insert Replace) (f a) (f b)
  crosswalk f (Insert b) = Insert <$> f b
  crosswalk f (Delete a) = Delete <$> f a

instance Pretty1 Patch where liftPretty = genericLiftPretty

instance Pretty a => Pretty (Patch a) where
  pretty = liftPretty pretty prettyList