{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Main (main) where
import Control.Monad
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
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
<$> [ (Compact, Xml, "other/line.svg"),
(Compact, Html, "other/ex1.html")
]
)
testExample :: (RenderStyle, Standard, FilePath) -> TestTree
testExample (r, s, fp) =
goldenTest
fp
(getMarkupFile s fp)
(isoMarkdownMarkup r s <$> getMarkupFile s fp)
(\expected actual -> pure (show . ansiWlEditExpr <$> patch expected actual))
(\_ -> pure ())
getMarkupFile :: Standard -> FilePath -> IO Markup
getMarkupFile s fp = do
bs <- B.readFile fp
pure $ warnError $ markup s bs
-- round trip markdown >>> markup
isoMarkdownMarkup :: RenderStyle -> Standard -> Markup -> Markup
isoMarkdownMarkup r s m = m & (markdown r s >=> markup s) & warnError
-- 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 (warnError $ markup Html m) (warnError $ 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|]