{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} module Main (main) where import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.Foldable import Data.Function import Data.Maybe import Data.String.Interpolate import Data.TreeDiff import MarkupParse import MarkupParse.Patch import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.Golden.Advanced (goldenTest) import Prelude main :: IO () main = defaultMain $ testGroup "tests" [ goldenTests ] goldenTests :: TestTree goldenTests = testGroup "examples" ( testExample <$> [ (Xml, "other/line.svg"), (Html, "other/ex1.html"), (Html, "other/Parsing - Wikipedia.html") ] ) testExample :: (Standard, FilePath) -> TestTree testExample (s, fp) = goldenTest fp (getMarkupFile s fp) (isoMarkdownMarkup s <$> getMarkupFile s fp) (\expected actual -> pure (show . ansiWlEditExpr <$> patch expected actual)) (\_ -> pure ()) getMarkupFile :: Standard -> FilePath -> IO Markup getMarkupFile s fp = do bs <- BS.readFile fp pure $ resultError $ markup s bs -- round trip markdown >>> markup isoMarkdownMarkup :: Standard -> Markup -> Markup isoMarkdownMarkup s m = m & markdown Compact & markup s & resultError -- patch testing printPatchExamples :: IO () printPatchExamples = traverse_ (printPatchExample m0) patchExamples printPatchExample :: ByteString -> (String, ByteString) -> IO () printPatchExample m (s, m') = do print s case show . ansiWlEditExpr <$> patch (resultError $ markup Html m) (resultError $ markup Html m') of Nothing -> putStrLn ("no changes" :: String) Just x -> putStrLn x patchExamples :: [(String, ByteString)] patchExamples = [ ("change an attribute name", m1'), ("change an attribute value", m1), ("delete an attribute", m2), ("insert an attribute", m3), ("change a tag", m4), ("change a markup leaf", m5), ("delete a leaf", m6), ("insert a leaf", m7), ("insert attribute", m8), ("modify content", m9), ("deep leaf insertion", m10) ] m0 :: ByteString m0 = [i|text|] -- Changing class m1 :: ByteString m1 = [i|text|] m1' :: ByteString m1' = [i|text|] -- deleting an attribute m2 :: ByteString m2 = [i|text|] -- inserting an attribute m3 :: ByteString m3 = [i|text|] -- changing a tag m4 :: ByteString m4 = [i|text|] -- changing a leaf m5 :: ByteString m5 = [i|text|] -- deleting a leaf m6 :: ByteString m6 = [i|text|] -- inserting a leaf m7 :: ByteString m7 = [i|text|] -- inserting Attributes m8 :: ByteString m8 = [i|text|] -- modifying content m9 :: ByteString m9 = [i|textual content|] -- inserting a leaf deeper down m10 :: ByteString m10 = [i|text|]