-- | A patch function for <https://hackage.haskell.org/package/tree-diff tree-diff>.
module MarkupParse.Patch
  ( patch,
    goldenPatch,
    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 Test.Tasty (TestTree)
import Test.Tasty.Golden.Advanced (goldenTest)
import Prelude

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

-- | Compare a file with a round-trip transformation.
goldenPatch :: (ToExpr a) => (FilePath -> IO a) -> (a -> a) -> FilePath -> TestTree
goldenPatch :: forall a.
ToExpr a =>
(String -> IO a) -> (a -> a) -> String -> TestTree
goldenPatch String -> IO a
f a -> a
testf String
fp =
  forall a.
String
-> IO a
-> IO a
-> (a -> a -> IO (Maybe String))
-> (a -> IO ())
-> TestTree
goldenTest
    String
fp
    (String -> IO a
f String
fp)
    (a -> a
testf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO a
f String
fp)
    (\a
expected a
actual -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Show a => a -> String
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 String
_ [Edit EditExpr]
xs) = [Edit EditExpr]
xs
getList (EditRec String
_ OMap String (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 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 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
$ 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 (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 String (Edit EditExpr)
m)) of
    Maybe (OMap String (Edit EditExpr))
Nothing -> forall a. Maybe a
Nothing
    Just OMap String (Edit EditExpr)
m' -> 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 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 String (Edit EditExpr) -> Maybe (OMap String (Edit EditExpr))
filterChangedEditMap OMap String (Edit EditExpr)
m = case [(String, Edit EditExpr)]
xs' of
  [] -> forall a. Maybe a
Nothing
  [(String, 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 [(String, Edit EditExpr)]
xs''
  where
    xs :: [(String, Edit EditExpr)]
xs = forall k v. OMap k v -> [(k, v)]
O.toList OMap String (Edit EditExpr)
m
    xs' :: [(String, Edit EditExpr)]
xs' = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. a -> (a -> b) -> b
& forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (Edit EditExpr -> Doc
ansiWlEditExpr forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. Show a => a -> String
show)