diff options
Diffstat (limited to 'source/Test/Unit/HtmlOutput.hs')
| -rw-r--r-- | source/Test/Unit/HtmlOutput.hs | 114 |
1 files changed, 63 insertions, 51 deletions
diff --git a/source/Test/Unit/HtmlOutput.hs b/source/Test/Unit/HtmlOutput.hs index 1993fc9..0087f82 100644 --- a/source/Test/Unit/HtmlOutput.hs +++ b/source/Test/Unit/HtmlOutput.hs @@ -4,7 +4,9 @@ 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 @@ -43,7 +45,7 @@ unitTests = "rejects a FIFO before publication" rejectsFifo , testCase - "reports and cleans an incomplete publication" + "reports and cleans the source-order publication prefix" reportsIncompletePublication ] @@ -94,36 +96,29 @@ publishesMountedExport = expectRight =<< existingRoot rootSource searchedExport <- expectRight =<< - prepareHtmlExport + prepareTestHtmlExport configuration mounts searched hints exactExport <- expectRight =<< - prepareHtmlExport + prepareTestHtmlExport configuration mounts exact hints assertEqual "root-form-independent destinations" - (preparedHtmlBundleDestinations - (preparedHtmlOutputBundle searchedExport)) - (preparedHtmlBundleDestinations - (preparedHtmlOutputBundle exactExport)) - assertEqual - "root-form-independent root document" - (preparedHtmlRootDocument searchedExport) - (preparedHtmlRootDocument exactExport) + (preparedHtmlArtifactDestination <$> searchedExport) + (preparedHtmlArtifactDestination <$> exactExport) - let bundle = - preparedHtmlOutputBundle searchedExport - rejectsBundleEscape temp bundle + let artifacts = searchedExport + rejectsArtifactEscape temp artifacts plan <- requirePlan =<< - planHtmlOutput outputRoot bundle + planHtmlOutput outputRoot artifacts outputExistsBeforePublication <- Directory.doesPathExist outputRoot assertBool @@ -168,11 +163,11 @@ publishesMountedExport = Html.supportScriptAssetContents supportText -rejectsBundleEscape +rejectsArtifactEscape :: FilePath - -> PreparedHtmlBundle + -> [PreparedHtmlArtifact] -> Assertion -rejectsBundleEscape temp bundle = do +rejectsArtifactEscape temp artifacts = do let outputRoot = temp </> "escape-html" outsideRoot = temp </> "outside" outsideMarker = outsideRoot </> "unchanged" @@ -182,7 +177,7 @@ rejectsBundleEscape temp bundle = do Directory.createDirectoryLink outsideRoot (outputRoot </> "docs") - result <- planHtmlOutput outputRoot bundle + result <- planHtmlOutput outputRoot artifacts case result of Left (HtmlOutputParentEscapesRoot @@ -223,8 +218,8 @@ writesPreparedBytes = , 0x63, 0x61, 0x66 , 0xc3, 0xa9 ] - bundle <- - makeBundle + artifacts <- + makeArtifacts [ ( "nested/über.html" , TextEncoding.encodeUtf8 pageText ) @@ -232,7 +227,7 @@ writesPreparedBytes = , TextEncoding.encodeUtf8 supportText ) ] - publishBundle outputRoot bundle + publishArtifacts outputRoot artifacts pageBytes <- ByteString.readFile (outputRoot </> "nested" </> "über.html") @@ -259,7 +254,7 @@ attachesBytesToReservedRoutes = ["page.html", "_static/naproche-html.js"]) routes <- requireRoutePlan =<< planHtmlRoutes outputRoot reserved - matching <- makeBundle + matching <- makeArtifacts [ ("page.html", "page") , ("_static/naproche-html.js", "support") ] @@ -268,7 +263,7 @@ attachesBytesToReservedRoutes = pure () Left failure -> assertFailure (show failure) - mismatched <- makeBundle + mismatched <- makeArtifacts [ ("other.html", "other") , ("_static/naproche-html.js", "support") ] @@ -295,12 +290,12 @@ rejectsFinalSymlink = ByteString.writeFile page "old page" ByteString.writeFile outsideAsset "outside asset" Directory.createFileLink outsideAsset support - bundle <- - makeBundle + artifacts <- + makeArtifacts [ ("page.html", "new page") , ("_static/naproche-html.js", "new support") ] - result <- planHtmlOutput outputRoot bundle + result <- planHtmlOutput outputRoot artifacts case result of Left (HtmlOutputTargetIsSymbolicLink target) -> assertEqual "rejected target" support target @@ -331,9 +326,9 @@ replacesHardLinkedTarget = Directory.createDirectory outputRoot ByteString.writeFile outsidePage "outside page" PosixFiles.createLink outsidePage page - bundle <- - makeBundle [("page.html", "new page")] - publishBundle outputRoot bundle + artifacts <- + makeArtifacts [("page.html", "new page")] + publishArtifacts outputRoot artifacts outsideBytes <- ByteString.readFile outsidePage pageBytes <- ByteString.readFile page assertEqual @@ -349,9 +344,9 @@ rejectsFifo = page = outputRoot </> "page.html" Directory.createDirectory outputRoot PosixFiles.createNamedPipe page PosixFiles.ownerModes - bundle <- - makeBundle [("page.html", "page")] - result <- planHtmlOutput outputRoot bundle + artifacts <- + makeArtifacts [("page.html", "page")] + result <- planHtmlOutput outputRoot artifacts case result of Left (HtmlOutputTargetNotRegularFile target) -> assertEqual "rejected target" page target @@ -369,18 +364,18 @@ reportsIncompletePublication :: Assertion reportsIncompletePublication = withTemporaryDirectory "felix-html-output-incomplete" \temp -> do let outputRoot = temp </> "html" - first = outputRoot </> "a.html" + first = outputRoot </> "z.html" blocked = outputRoot </> "b.html" - unpublished = outputRoot </> "c.html" - bundle <- - makeBundle - [ ("a.html", "first") + unpublished = outputRoot </> "a.html" + artifacts <- + makeArtifacts + [ ("z.html", "first") , ("b.html", "blocked") - , ("c.html", "unpublished") + , ("a.html", "unpublished") ] plan <- requirePlan =<< - planHtmlOutput outputRoot bundle + planHtmlOutput outputRoot artifacts Directory.createDirectory outputRoot Directory.createDirectory blocked result <- writeHtmlOutput plan @@ -392,7 +387,7 @@ reportsIncompletePublication = } -> do expectedFirst <- expectRight - (safeRelativePath "a.html") + (safeRelativePath "z.html") expectedBlocked <- expectRight (safeRelativePath "b.html") @@ -429,23 +424,22 @@ reportsIncompletePublication = outputEntries)) -publishBundle +publishArtifacts :: FilePath - -> PreparedHtmlBundle + -> [PreparedHtmlArtifact] -> IO () -publishBundle outputRoot bundle = do +publishArtifacts outputRoot artifacts = do plan <- - requirePlan =<< planHtmlOutput outputRoot bundle + requirePlan =<< planHtmlOutput outputRoot artifacts requirePublication =<< writeHtmlOutput plan -makeBundle +makeArtifacts :: [(FilePath, ByteString.ByteString)] - -> IO PreparedHtmlBundle -makeBundle artifacts = do - prepared <- for artifacts \(path, bytes) -> do + -> IO [PreparedHtmlArtifact] +makeArtifacts artifacts = + for artifacts \(path, bytes) -> do relative <- expectRight (safeRelativePath path) - pure (relative, bytes) - expectRight (preparedHtmlBundle prepared) + pure (preparedHtmlArtifact relative (Right bytes)) requirePlan :: Either HtmlOutputError HtmlOutputPlan @@ -484,6 +478,24 @@ readUtf8 path = do 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 |