Migrate to `Felix` namespaceHEADhotg

1 files changed, 0 insertions, 560 deletions

diff --git a/source/Test/Unit/HtmlOutput.hs b/source/Test/Unit/HtmlOutput.hs
deleted file mode 100644
index 0087f82..0000000
--- a/source/Test/Unit/HtmlOutput.hs
+++ /dev/null
@@ -1,560 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Test.Unit.HtmlOutput (unitTests) where
-
-import Base
-import Felix.Parse qualified as Parse
-import Felix.Source
-import Felix.Source.Graph qualified as SourceGraph
-import Render.Html qualified as Html
-import Render.Html.Export
-import Render.Html.Output
-
-import Control.Exception (bracket)
-import Data.ByteString qualified as ByteString
-import Data.List qualified as List
-import Data.Text qualified as Text
-import Data.Text.Encoding qualified as TextEncoding
-import System.Directory qualified as Directory
-import System.FilePath.Posix ((</>))
-import System.Posix.Files qualified as PosixFiles
-import Test.Tasty
-import Test.Tasty.HUnit
-
-
-unitTests :: TestTree
-unitTests =
-    testGroup "HTML output"
-        [ testCase
-            "publishes a mounted multi-page UTF-8 export"
-            publishesMountedExport
-        , testCase
-            "writes prepared strict bytes"
-            writesPreparedBytes
-        , testCase
-            "attaches bytes only to reserved routes"
-            attachesBytesToReservedRoutes
-        , testCase
-            "rejects a final symlink before publication"
-            rejectsFinalSymlink
-        , testCase
-            "replaces hard-linked targets without changing peers"
-            replacesHardLinkedTarget
-        , testCase
-            "rejects a FIFO before publication"
-            rejectsFifo
-        , testCase
-            "reports and cleans the source-order publication prefix"
-            reportsIncompletePublication
-        ]
-
-
-publishesMountedExport :: Assertion
-publishesMountedExport =
-    withTemporaryDirectory "felix-html-export" \temp -> do
-        let projectRoot = temp </> "project"
-            libraryRoot = temp </> "library"
-            projectDirectory = projectRoot </> "docs"
-            libraryDirectory = libraryRoot </> "shared"
-            rootSource = projectDirectory </> "über #.tex"
-            importedSource =
-                libraryDirectory </> "sets #.tex"
-            outputRoot = temp </> "html"
-            rootPage = outputRoot </> "docs" </> "über #.html"
-            importedPage =
-                outputRoot
-                    </> "library"
-                    </> "shared"
-                    </> "sets #.html"
-            supportAsset =
-                outputRoot
-                    </> "_static"
-                    </> "naproche-html.js"
-            configuration =
-                [ (sourceMountId "project", [])
-                , (sourceMountId "library", ["library"])
-                ]
-            hints =
-                "relation\teq\t0\t<mo>=</mo>\n"
-        Directory.createDirectory projectRoot
-        Directory.createDirectory libraryRoot
-        Directory.createDirectory projectDirectory
-        Directory.createDirectory libraryDirectory
-        writeImportedTheory importedSource
-        writeRootTheory rootSource
-        mounts <-
-            expectRight =<<
-                prepareSourceMounts
-                    [ (sourceMountId "project", projectRoot)
-                    , (sourceMountId "library", libraryRoot)
-                    ]
-        searched <-
-            expectRight
-                (searchedRoot "docs/über #.tex")
-        exact <-
-            expectRight =<< existingRoot rootSource
-        searchedExport <-
-            expectRight =<<
-                prepareTestHtmlExport
-                    configuration
-                    mounts
-                    searched
-                    hints
-        exactExport <-
-            expectRight =<<
-                prepareTestHtmlExport
-                    configuration
-                    mounts
-                    exact
-                    hints
-        assertEqual
-            "root-form-independent destinations"
-            (preparedHtmlArtifactDestination <$> searchedExport)
-            (preparedHtmlArtifactDestination <$> exactExport)
-
-        let artifacts = searchedExport
-        rejectsArtifactEscape temp artifacts
-
-        plan <-
-            requirePlan =<<
-                planHtmlOutput outputRoot artifacts
-        outputExistsBeforePublication <-
-            Directory.doesPathExist outputRoot
-        assertBool
-            "preflight created the output root"
-            (not outputExistsBeforePublication)
-        requirePublication =<< writeHtmlOutput plan
-
-        rootText <- readUtf8 rootPage
-        importedText <- readUtf8 importedPage
-        supportText <- readUtf8 supportAsset
-        assertContains
-            "root heading"
-            "<h1>project:docs/über #.tex</h1>"
-            rootText
-        assertContains
-            "imported heading"
-            "<h1>library:shared/sets #.tex</h1>"
-            importedText
-        assertContains
-            "encoded imported reference"
-            "href=\"../library/shared/sets%20%23#imported_prop\""
-            rootText
-        assertContains
-            "encoded imported source link"
-            "href=\"../library/shared/sets%20%23\"><code>library:shared/sets #.tex</code>"
-            rootText
-        assertContains
-            "root support route"
-            "src=\"../_static/naproche-html.js\""
-            rootText
-        assertContains
-            "imported support route"
-            "src=\"../../_static/naproche-html.js\""
-            importedText
-        for_ [rootText, importedText] \document ->
-            assertContains
-                "UTF-8 declaration"
-                "<meta charset=\"utf-8\">"
-                document
-        assertEqual
-            "support asset"
-            Html.supportScriptAssetContents
-            supportText
-
-rejectsArtifactEscape
-    :: FilePath
-    -> [PreparedHtmlArtifact]
-    -> Assertion
-rejectsArtifactEscape temp artifacts = do
-    let outputRoot = temp </> "escape-html"
-        outsideRoot = temp </> "outside"
-        outsideMarker = outsideRoot </> "unchanged"
-    Directory.createDirectory outputRoot
-    Directory.createDirectory outsideRoot
-    ByteString.writeFile outsideMarker "outside"
-    Directory.createDirectoryLink
-        outsideRoot
-        (outputRoot </> "docs")
-    result <- planHtmlOutput outputRoot artifacts
-    case result of
-        Left
-            (HtmlOutputParentEscapesRoot
-                _parent
-                canonicalParent) -> do
-                    expectedOutside <-
-                        Directory.canonicalizePath outsideRoot
-                    assertEqual
-                        "escaping route target"
-                        expectedOutside
-                        canonicalParent
-        other ->
-            assertFailure
-                ("expected output-root escape rejection, got "
-                    <> showPlanResult other)
-    outsideBytes <- ByteString.readFile outsideMarker
-    assertEqual
-        "escape planning changed the outside tree"
-        "outside"
-        outsideBytes
-    supportExists <-
-        Directory.doesPathExist
-            (outputRoot </> "_static")
-    assertBool
-        "escape preflight created another destination"
-        (not supportExists)
-
-writesPreparedBytes :: Assertion
-writesPreparedBytes =
-    withTemporaryDirectory "felix-html-output-bytes" \temp -> do
-        let outputRoot = temp </> "html"
-            pageText = "∀ café"
-            supportText = "const π = 3;"
-            expectedPageBytes =
-                ByteString.pack
-                    [ 0xe2, 0x88, 0x80
-                    , 0x20
-                    , 0x63, 0x61, 0x66
-                    , 0xc3, 0xa9
-                    ]
-        artifacts <-
-            makeArtifacts
-                [ ( "nested/über.html"
-                  , TextEncoding.encodeUtf8 pageText
-                  )
-                , ( "_static/naproche-html.js"
-                  , TextEncoding.encodeUtf8 supportText
-                  )
-                ]
-        publishArtifacts outputRoot artifacts
-        pageBytes <-
-            ByteString.readFile
-                (outputRoot </> "nested" </> "über.html")
-        supportBytes <-
-            ByteString.readFile
-                (outputRoot
-                    </> "_static"
-                    </> "naproche-html.js")
-        assertEqual
-            "exact page UTF-8 bytes"
-            expectedPageBytes
-            pageBytes
-        assertEqual
-            "exact support bytes"
-            (TextEncoding.encodeUtf8 supportText)
-            supportBytes
-
-attachesBytesToReservedRoutes :: Assertion
-attachesBytesToReservedRoutes =
-    withTemporaryDirectory "felix-html-output-routes" \temp -> do
-        let outputRoot = temp </> "html"
-        reserved <- expectRight
-            (traverse safeRelativePath
-                ["page.html", "_static/naproche-html.js"])
-        routes <- requireRoutePlan =<<
-            planHtmlRoutes outputRoot reserved
-        matching <- makeArtifacts
-            [ ("page.html", "page")
-            , ("_static/naproche-html.js", "support")
-            ]
-        case planHtmlOutputAgainst routes matching of
-            Right _ ->
-                pure ()
-            Left failure ->
-                assertFailure (show failure)
-        mismatched <- makeArtifacts
-            [ ("other.html", "other")
-            , ("_static/naproche-html.js", "support")
-            ]
-        case planHtmlOutputAgainst routes mismatched of
-            Left HtmlOutputRouteMismatch{} ->
-                pure ()
-            Left failure ->
-                assertFailure
-                    ("unexpected route mismatch: " <> show failure)
-            Right _ ->
-                assertFailure "unreserved HTML route was accepted"
-
-rejectsFinalSymlink :: Assertion
-rejectsFinalSymlink =
-    withTemporaryDirectory "felix-html-output-final-link" \temp -> do
-        let outputRoot = temp </> "html"
-            supportDirectory = outputRoot </> "_static"
-            page = outputRoot </> "page.html"
-            support =
-                supportDirectory </> "naproche-html.js"
-            outsideAsset = temp </> "outside.js"
-        Directory.createDirectory outputRoot
-        Directory.createDirectory supportDirectory
-        ByteString.writeFile page "old page"
-        ByteString.writeFile outsideAsset "outside asset"
-        Directory.createFileLink outsideAsset support
-        artifacts <-
-            makeArtifacts
-                [ ("page.html", "new page")
-                , ("_static/naproche-html.js", "new support")
-                ]
-        result <- planHtmlOutput outputRoot artifacts
-        case result of
-            Left (HtmlOutputTargetIsSymbolicLink target) ->
-                assertEqual "rejected target" support target
-            other ->
-                assertFailure
-                    ("expected final symlink rejection, got "
-                        <> showPlanResult other)
-        pageBytes <- ByteString.readFile page
-        outsideBytes <- ByteString.readFile outsideAsset
-        supportIsLink <-
-            Directory.pathIsSymbolicLink support
-        assertEqual
-            "page changed before complete preflight"
-            "old page"
-            pageBytes
-        assertEqual
-            "symlink referent changed"
-            "outside asset"
-            outsideBytes
-        assertBool "final symlink was replaced" supportIsLink
-
-replacesHardLinkedTarget :: Assertion
-replacesHardLinkedTarget =
-    withTemporaryDirectory "felix-html-output-hard-link" \temp -> do
-        let outputRoot = temp </> "html"
-            page = outputRoot </> "page.html"
-            outsidePage = temp </> "outside.html"
-        Directory.createDirectory outputRoot
-        ByteString.writeFile outsidePage "outside page"
-        PosixFiles.createLink outsidePage page
-        artifacts <-
-            makeArtifacts [("page.html", "new page")]
-        publishArtifacts outputRoot artifacts
-        outsideBytes <- ByteString.readFile outsidePage
-        pageBytes <- ByteString.readFile page
-        assertEqual
-            "outside hard-link peer changed"
-            "outside page"
-            outsideBytes
-        assertEqual "page was not replaced" "new page" pageBytes
-
-rejectsFifo :: Assertion
-rejectsFifo =
-    withTemporaryDirectory "felix-html-output-fifo" \temp -> do
-        let outputRoot = temp </> "html"
-            page = outputRoot </> "page.html"
-        Directory.createDirectory outputRoot
-        PosixFiles.createNamedPipe page PosixFiles.ownerModes
-        artifacts <-
-            makeArtifacts [("page.html", "page")]
-        result <- planHtmlOutput outputRoot artifacts
-        case result of
-            Left (HtmlOutputTargetNotRegularFile target) ->
-                assertEqual "rejected target" page target
-            other ->
-                assertFailure
-                    ("expected FIFO rejection, got "
-                        <> showPlanResult other)
-        pageStatus <-
-            PosixFiles.getSymbolicLinkStatus page
-        assertBool
-            "FIFO target was replaced"
-            (PosixFiles.isNamedPipe pageStatus)
-
-reportsIncompletePublication :: Assertion
-reportsIncompletePublication =
-    withTemporaryDirectory "felix-html-output-incomplete" \temp -> do
-        let outputRoot = temp </> "html"
-            first = outputRoot </> "z.html"
-            blocked = outputRoot </> "b.html"
-            unpublished = outputRoot </> "a.html"
-        artifacts <-
-            makeArtifacts
-                [ ("z.html", "first")
-                , ("b.html", "blocked")
-                , ("a.html", "unpublished")
-                ]
-        plan <-
-            requirePlan =<<
-                planHtmlOutput outputRoot artifacts
-        Directory.createDirectory outputRoot
-        Directory.createDirectory blocked
-        result <- writeHtmlOutput plan
-        case result of
-            Left
-                IncompleteHtmlPublication
-                    { committedHtmlDestinations
-                    , failedHtmlDestination
-                    } -> do
-                        expectedFirst <-
-                            expectRight
-                                (safeRelativePath "z.html")
-                        expectedBlocked <-
-                            expectRight
-                                (safeRelativePath "b.html")
-                        assertEqual
-                            "committed destinations"
-                            [expectedFirst]
-                            committedHtmlDestinations
-                        assertEqual
-                            "failed destination"
-                            expectedBlocked
-                            failedHtmlDestination
-            Right () ->
-                assertFailure
-                    "expected incomplete publication"
-        firstBytes <- ByteString.readFile first
-        unpublishedExists <-
-            Directory.doesPathExist unpublished
-        blockedIsDirectory <-
-            Directory.doesDirectoryExist blocked
-        outputEntries <-
-            Directory.listDirectory outputRoot
-        assertEqual "first artifact" "first" firstBytes
-        assertBool
-            "later artifact was published"
-            (not unpublishedExists)
-        assertBool
-            "injected blocker was replaced"
-            blockedIsDirectory
-        assertBool
-            "unpublished temporary files remain"
-            (not
-                (any
-                    (List.isInfixOf ".tmp")
-                    outputEntries))
-
-
-publishArtifacts
-    :: FilePath
-    -> [PreparedHtmlArtifact]
-    -> IO ()
-publishArtifacts outputRoot artifacts = do
-    plan <-
-        requirePlan =<< planHtmlOutput outputRoot artifacts
-    requirePublication =<< writeHtmlOutput plan
-
-makeArtifacts
-    :: [(FilePath, ByteString.ByteString)]
-    -> IO [PreparedHtmlArtifact]
-makeArtifacts artifacts =
-    for artifacts \(path, bytes) -> do
-        relative <- expectRight (safeRelativePath path)
-        pure (preparedHtmlArtifact relative (Right bytes))
-
-requirePlan
-    :: Either HtmlOutputError HtmlOutputPlan
-    -> IO HtmlOutputPlan
-requirePlan =
-    expectRight
-
-requireRoutePlan
-    :: Either HtmlOutputError HtmlRoutePlan
-    -> IO HtmlRoutePlan
-requireRoutePlan =
-    expectRight
-
-requirePublication
-    :: Either HtmlPublicationError ()
-    -> IO ()
-requirePublication =
-    expectRight
-
-showPlanResult
-    :: Either HtmlOutputError HtmlOutputPlan
-    -> String
-showPlanResult = \case
-    Left err ->
-        show err
-    Right _plan ->
-        "successful output plan"
-
-readUtf8 :: FilePath -> IO Text
-readUtf8 path = do
-    bytes <- ByteString.readFile path
-    case TextEncoding.decodeUtf8' bytes of
-        Left err ->
-            assertFailure
-                ("invalid UTF-8 output: " <> show err)
-        Right text ->
-            pure text
-
-prepareTestHtmlExport
-    :: [(SourceMountId, [Text])]
-    -> SourceMounts
-    -> RootRequest
-    -> Text
-    -> IO (Either HtmlExportError [PreparedHtmlArtifact])
-prepareTestHtmlExport configuration mounts request hints = do
-    graph <-
-        expectRight =<<
-            SourceGraph.buildResolvedSourceGraph mounts request
-    workspace <-
-        expectRight =<< Parse.parseResolvedSourceGraph graph
-    pure
-        (prepareHtmlExport
-            configuration
-            (htmlPresentationFromParsedWorkspace workspace)
-            hints)
-
-writeImportedTheory :: FilePath -> IO ()
-writeImportedTheory path =
-    writeFile path
-        (unlines
-            [ "\\begin{proposition}\\label{imported_prop}"
-            , "  $i = i$."
-            , "\\end{proposition}"
-            ])
-
-writeRootTheory :: FilePath -> IO ()
-writeRootTheory path =
-    writeFile path
-        (unlines
-            [ "\\import{shared/sets #.tex}"
-            , "\\begin{proposition}\\label{local_prop}"
-            , "  $a = a$."
-            , "\\end{proposition}"
-            , "\\begin{proposition}\\label{uses_import}"
-            , "  $b = b$."
-            , "\\end{proposition}"
-            , "\\begin{proof}"
-            , "  Follows by \\cref{imported_prop}."
-            , "\\end{proof}"
-            ])
-
-assertContains
-    :: String
-    -> Text
-    -> Text
-    -> Assertion
-assertContains description needle haystack =
-    assertBool
-        (description <> ": missing " <> show needle)
-        (needle `Text.isInfixOf` haystack)
-
-expectRight
-    :: (Show e, HasCallStack)
-    => Either e a
-    -> IO a
-expectRight = \case
-    Left err ->
-        assertFailure
-            ("expected Right, got Left " <> show err)
-    Right value ->
-        pure value
-
-withTemporaryDirectory
-    :: String
-    -> (FilePath -> IO a)
-    -> IO a
-withTemporaryDirectory template =
-    bracket create Directory.removePathForcibly
-  where
-    create = do
-        systemTemp <-
-            Directory.getTemporaryDirectory
-        (path, handle) <-
-            openTempFile systemTemp template
-        hClose handle
-        Directory.removeFile path
-        Directory.createDirectory path
-        pure path