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

import Data.Foldable
import Data.Maybe
import Data.TreeDiff
import Data.TreeDiff.OMap qualified as O
import GHC.Exts
import Test.Tasty (TestTree)
import Test.Tasty.Golden.Advanced (goldenTest)
import Prelude

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Data.TreeDiff
-- >>> import MarkupParse.Patch

-- | compare a markup file with a round-trip transformation.
goldenPatch :: (ToExpr a) => (FilePath -> IO a) -> (a -> a) -> FilePath -> TestTree
goldenPatch :: forall a.
ToExpr a =>
(FieldName -> IO a) -> (a -> a) -> FieldName -> TestTree
goldenPatch FieldName -> IO a
f a -> a
testf FieldName
fp =
  forall a.
FieldName
-> IO a
-> IO a
-> (a -> a -> IO (Maybe FieldName))
-> (a -> IO ())
-> TestTree
goldenTest
    FieldName
fp
    (FieldName -> IO a
f FieldName
fp)
    (a -> a
testf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName -> IO a
f FieldName
fp)
    (\a
expected a
actual -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Show a => a -> FieldName
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edit EditExpr -> Doc
ansiWlEditExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToExpr a => a -> a -> Maybe (Edit EditExpr)
patch a
expected a
actual))
    (\a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

isUnchangedList :: [Edit EditExpr] -> Bool
isUnchangedList :: [Edit EditExpr] -> Bool
isUnchangedList [Edit EditExpr]
xs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Edit a -> Bool
isCpy [Edit EditExpr]
xs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all EditExpr -> Bool
isUnchangedExpr (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe 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) = forall a. a -> Maybe a
Just a
a
cpy Edit 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 forall a b. (a -> b) -> a -> b
$ EditExpr -> [Edit EditExpr]
getList EditExpr
e

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

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

filterChangedEdit :: Edit EditExpr -> Maybe (Edit EditExpr)
filterChangedEdit :: Edit EditExpr -> Maybe (Edit EditExpr)
filterChangedEdit (Cpy EditExpr
a) = forall a. a -> Edit a
Cpy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EditExpr -> Maybe EditExpr
filterChangedExprs EditExpr
a
filterChangedEdit Edit EditExpr
x = 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,) 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 = 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 FieldName (Edit EditExpr)
-> Maybe (OMap FieldName (Edit EditExpr))
filterChangedEditMap OMap FieldName (Edit EditExpr)
m = case [(FieldName, Edit EditExpr)]
xs' of
  [] -> forall a. Maybe a
Nothing
  [(FieldName, Edit EditExpr)]
xs'' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> OMap k v
O.fromList [(FieldName, Edit EditExpr)]
xs''
  where
    xs :: [(FieldName, Edit EditExpr)]
xs = forall k v. OMap k v -> [(k, v)]
O.toList OMap FieldName (Edit EditExpr)
m
    xs' :: [(FieldName, Edit EditExpr)]
xs' = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall f. (f, Edit EditExpr) -> Maybe (f, Edit EditExpr)
filterChangedEdit' [(FieldName, Edit EditExpr)]
xs

-- | 'ediff' with unchanged sections filtered out
--
-- >>> show $ ansiWlEditExpr <$> patch [1, 2, 3, 5] [0, 1, 2, 4, 6]
-- "Just [+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 forall a b. (a -> b) -> a -> b
$ forall a. ToExpr a => a -> a -> Edit EditExpr
ediff a
m a
m'