-- | A patch function for <https://hackage.haskell.org/package/tree-diff tree-diff>.
module CabalFix.Patch
  ( patch,
    showPatch,
  )
where

import Control.Category ((>>>))
import Data.Foldable
import Data.Function
import Data.Maybe
import Data.TreeDiff
import Data.TreeDiff.OMap qualified as O
import GHC.Exts
import Prelude

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import CabalFix.Patch

isUnchangedList :: [Edit EditExpr] -> Bool
isUnchangedList :: [Edit EditExpr] -> Bool
isUnchangedList [Edit EditExpr]
xs = (Edit EditExpr -> Bool) -> [Edit EditExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Edit EditExpr -> Bool
forall a. Edit a -> Bool
isCpy [Edit EditExpr]
xs Bool -> Bool -> Bool
&& (EditExpr -> Bool) -> [EditExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all EditExpr -> Bool
isUnchangedExpr ((Edit EditExpr -> Maybe EditExpr) -> [Edit EditExpr] -> [EditExpr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Edit EditExpr -> Maybe EditExpr
forall a. Edit a -> Maybe a
cpy [Edit EditExpr]
xs)

isCpy :: Edit a -> Bool
isCpy :: forall a. Edit a -> Bool
isCpy (Cpy a
_) = Bool
True
isCpy Edit a
_ = Bool
False

cpy :: Edit a -> Maybe a
cpy :: forall a. Edit a -> Maybe a
cpy (Cpy a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
cpy Edit a
_ = Maybe a
forall a. Maybe a
Nothing

isUnchangedEdit :: Edit EditExpr -> Bool
isUnchangedEdit :: Edit EditExpr -> Bool
isUnchangedEdit (Cpy EditExpr
e) = EditExpr -> Bool
isUnchangedExpr EditExpr
e
isUnchangedEdit Edit EditExpr
_ = Bool
False

isUnchangedExpr :: EditExpr -> Bool
isUnchangedExpr :: EditExpr -> Bool
isUnchangedExpr EditExpr
e = [Edit EditExpr] -> Bool
isUnchangedList ([Edit EditExpr] -> Bool) -> [Edit EditExpr] -> Bool
forall a b. (a -> b) -> a -> b
$ EditExpr -> [Edit EditExpr]
getList EditExpr
e

getList :: EditExpr -> [Edit EditExpr]
getList :: EditExpr -> [Edit EditExpr]
getList (EditApp String
_ [Edit EditExpr]
xs) = [Edit EditExpr]
xs
getList (EditRec String
_ OMap String (Edit EditExpr)
m) = (String, Edit EditExpr) -> Edit EditExpr
forall a b. (a, b) -> b
snd ((String, Edit EditExpr) -> Edit EditExpr)
-> [(String, Edit EditExpr)] -> [Edit EditExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OMap String (Edit EditExpr) -> [(String, Edit EditExpr)]
forall k v. OMap k v -> [(k, v)]
O.toList OMap String (Edit EditExpr)
m
getList (EditLst [Edit EditExpr]
xs) = [Edit EditExpr]
xs
getList (EditExp Expr
_) = []

filterChangedExprs :: EditExpr -> Maybe EditExpr
filterChangedExprs :: EditExpr -> Maybe EditExpr
filterChangedExprs (EditApp String
n [Edit EditExpr]
xs) =
  case (Edit EditExpr -> Bool) -> [Edit EditExpr] -> [Edit EditExpr]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Edit EditExpr -> Bool) -> Edit EditExpr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edit EditExpr -> Bool
isUnchangedEdit) ([Edit EditExpr] -> [Edit EditExpr]
filterChangedEdits [Edit EditExpr]
xs) of
    [] -> Maybe EditExpr
forall a. Maybe a
Nothing
    [Edit EditExpr]
xs' -> EditExpr -> Maybe EditExpr
forall a. a -> Maybe a
Just (EditExpr -> Maybe EditExpr) -> EditExpr -> Maybe EditExpr
forall a b. (a -> b) -> a -> b
$ String -> [Edit EditExpr] -> EditExpr
EditApp String
n [Edit EditExpr]
xs'
filterChangedExprs (EditRec String
n OMap String (Edit EditExpr)
m) =
  case OMap String (Edit EditExpr) -> Maybe (OMap String (Edit EditExpr))
filterChangedEditMap ([(String, Edit EditExpr)] -> OMap String (Edit EditExpr)
forall k v. Ord k => [(k, v)] -> OMap k v
O.fromList ([(String, Edit EditExpr)] -> OMap String (Edit EditExpr))
-> [(String, Edit EditExpr)] -> OMap String (Edit EditExpr)
forall a b. (a -> b) -> a -> b
$ ((String, Edit EditExpr) -> Bool)
-> [(String, Edit EditExpr)] -> [(String, Edit EditExpr)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, Edit EditExpr) -> Bool)
-> (String, Edit EditExpr)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edit EditExpr -> Bool
isUnchangedEdit (Edit EditExpr -> Bool)
-> ((String, Edit EditExpr) -> Edit EditExpr)
-> (String, Edit EditExpr)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Edit EditExpr) -> Edit EditExpr
forall a b. (a, b) -> b
snd) (OMap String (Edit EditExpr) -> [(String, Edit EditExpr)]
forall k v. OMap k v -> [(k, v)]
O.toList OMap String (Edit EditExpr)
m)) of
    Maybe (OMap String (Edit EditExpr))
Nothing -> Maybe EditExpr
forall a. Maybe a
Nothing
    Just OMap String (Edit EditExpr)
m' -> EditExpr -> Maybe EditExpr
forall a. a -> Maybe a
Just (String -> OMap String (Edit EditExpr) -> EditExpr
EditRec String
n OMap String (Edit EditExpr)
m')
filterChangedExprs (EditLst [Edit EditExpr]
xs) =
  case (Edit EditExpr -> Bool) -> [Edit EditExpr] -> [Edit EditExpr]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Edit EditExpr -> Bool) -> Edit EditExpr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edit EditExpr -> Bool
isUnchangedEdit) ([Edit EditExpr] -> [Edit EditExpr]
filterChangedEdits [Edit EditExpr]
xs) of
    [] -> Maybe EditExpr
forall a. Maybe a
Nothing
    [Edit EditExpr]
xs' -> EditExpr -> Maybe EditExpr
forall a. a -> Maybe a
Just ([Edit EditExpr] -> EditExpr
EditLst [Edit EditExpr]
xs')
filterChangedExprs (EditExp Expr
_) = Maybe EditExpr
forall a. Maybe a
Nothing

filterChangedEdit :: Edit EditExpr -> Maybe (Edit EditExpr)
filterChangedEdit :: Edit EditExpr -> Maybe (Edit EditExpr)
filterChangedEdit (Cpy EditExpr
a) = EditExpr -> Edit EditExpr
forall a. a -> Edit a
Cpy (EditExpr -> Edit EditExpr)
-> Maybe EditExpr -> Maybe (Edit EditExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EditExpr -> Maybe EditExpr
filterChangedExprs EditExpr
a
filterChangedEdit Edit EditExpr
x = Edit EditExpr -> Maybe (Edit EditExpr)
forall a. a -> Maybe a
Just Edit EditExpr
x

filterChangedEdit' :: (f, Edit EditExpr) -> Maybe (f, Edit EditExpr)
filterChangedEdit' :: forall f. (f, Edit EditExpr) -> Maybe (f, Edit EditExpr)
filterChangedEdit' (f
f, Edit EditExpr
e) = (f
f,) (Edit EditExpr -> (f, Edit EditExpr))
-> Maybe (Edit EditExpr) -> Maybe (f, Edit EditExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Edit EditExpr -> Maybe (Edit EditExpr)
filterChangedEdit Edit EditExpr
e

filterChangedEdits :: [Edit EditExpr] -> [Edit EditExpr]
filterChangedEdits :: [Edit EditExpr] -> [Edit EditExpr]
filterChangedEdits [Edit EditExpr]
xs = (Edit EditExpr -> Maybe (Edit EditExpr))
-> [Edit EditExpr] -> [Edit EditExpr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Edit EditExpr -> Maybe (Edit EditExpr)
filterChangedEdit [Edit EditExpr]
xs

filterChangedEditMap :: O.OMap FieldName (Edit EditExpr) -> Maybe (O.OMap FieldName (Edit EditExpr))
filterChangedEditMap :: OMap String (Edit EditExpr) -> Maybe (OMap String (Edit EditExpr))
filterChangedEditMap OMap String (Edit EditExpr)
m = case [(String, Edit EditExpr)]
xs' of
  [] -> Maybe (OMap String (Edit EditExpr))
forall a. Maybe a
Nothing
  [(String, Edit EditExpr)]
xs'' -> OMap String (Edit EditExpr) -> Maybe (OMap String (Edit EditExpr))
forall a. a -> Maybe a
Just (OMap String (Edit EditExpr)
 -> Maybe (OMap String (Edit EditExpr)))
-> OMap String (Edit EditExpr)
-> Maybe (OMap String (Edit EditExpr))
forall a b. (a -> b) -> a -> b
$ [(String, Edit EditExpr)] -> OMap String (Edit EditExpr)
forall k v. Ord k => [(k, v)] -> OMap k v
O.fromList [(String, Edit EditExpr)]
xs''
  where
    xs :: [(String, Edit EditExpr)]
xs = OMap String (Edit EditExpr) -> [(String, Edit EditExpr)]
forall k v. OMap k v -> [(k, v)]
O.toList OMap String (Edit EditExpr)
m
    xs' :: [(String, Edit EditExpr)]
xs' = ((String, Edit EditExpr) -> Maybe (String, Edit EditExpr))
-> [(String, Edit EditExpr)] -> [(String, Edit EditExpr)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, Edit EditExpr) -> Maybe (String, Edit EditExpr)
forall f. (f, Edit EditExpr) -> Maybe (f, Edit EditExpr)
filterChangedEdit' [(String, Edit EditExpr)]
xs

-- | 'ediff' with unchanged sections filtered out
--
-- >>> showPatch $ patch [1, 2, 3, 5] [0, 1, 2, 4, 6]
-- "[+0, -3, +4, -5, +6]"
patch :: (ToExpr a) => a -> a -> Maybe (Edit EditExpr)
patch :: forall a. ToExpr a => a -> a -> Maybe (Edit EditExpr)
patch a
m a
m' = Edit EditExpr -> Maybe (Edit EditExpr)
filterChangedEdit (Edit EditExpr -> Maybe (Edit EditExpr))
-> Edit EditExpr -> Maybe (Edit EditExpr)
forall a b. (a -> b) -> a -> b
$ a -> a -> Edit EditExpr
forall a. ToExpr a => a -> a -> Edit EditExpr
ediff a
m a
m'

-- | Create a String representation of a patch.
showPatch :: Maybe (Edit EditExpr) -> String
showPatch :: Maybe (Edit EditExpr) -> String
showPatch Maybe (Edit EditExpr)
p = Maybe (Edit EditExpr)
p Maybe (Edit EditExpr)
-> (Maybe (Edit EditExpr) -> String) -> String
forall a b. a -> (a -> b) -> b
& String
-> (Edit EditExpr -> String) -> Maybe (Edit EditExpr) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
forall a. Monoid a => a
mempty (Edit EditExpr -> Doc
ansiWlEditExpr (Edit EditExpr -> Doc)
-> (Doc -> String) -> Edit EditExpr -> String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Doc -> String
forall a. Show a => a -> String
show)