diff options
Diffstat (limited to 'source/Test/Unit/Html.hs')
| -rw-r--r-- | source/Test/Unit/Html.hs | 47 |
1 files changed, 43 insertions, 4 deletions
diff --git a/source/Test/Unit/Html.hs b/source/Test/Unit/Html.hs index 7dd2837..14ecdc3 100644 --- a/source/Test/Unit/Html.hs +++ b/source/Test/Unit/Html.hs @@ -4,6 +4,7 @@ module Test.Unit.Html (unitTests) where import Base import Api qualified +import Felix.Parse qualified as Parse import Felix.Source import Felix.Source.Graph import Render.Html qualified as Html @@ -13,20 +14,55 @@ import Report.Location (Location, pattern Nowhere) import Syntax.Abstract import Data.Text qualified as Text +import Data.Text.IO qualified as TextIO +import Data.List.NonEmpty qualified as NonEmpty import System.Directory qualified as Directory import Test.Tasty import Test.Tasty.HUnit unitTests :: TestTree unitTests = testGroup "HTML renderer" - [ testCase "reference previews are rendered for local and imported refs" referencePreviews + [ testCase "one shared index resolves local and cross-page previews" referencePreviews , testCase "missing reference preview data falls back to readable text" missingReferenceFallback , testCase "datatype rendering omits unchecked derived facts" datatypeDerivedFactsAreOmitted ] referencePreviews :: Assertion referencePreviews = do - html <- Api.exportHtml "test/html-fixtures/root-preview.tex" + graph <- + expectRight =<< + Api.prepareDefaultSourceGraph + "test/html-fixtures/root-preview.tex" + workspace <- + expectRight =<< Parse.parseResolvedSourceGraph graph + hints <- TextIO.readFile "library/lexicon.tsv" + layout <- + expectRight + (layoutHtmlSourceGraph + Api.defaultHtmlMountPrefixes + graph) + let nodes = Parse.parsedWorkspaceImportedBeforeImporter workspace + sourceBlocks = + (\node -> + ( Parse.parsedModuleResolved node + , Parse.parsedModuleBlocks node + )) + <$> nodes + (renderIndex, pages) = + Html.buildRenderIndex sourceBlocks + rootPage = NonEmpty.last pages + context <- + expectRight + (htmlRenderContext + layout + (Html.htmlPagePresentationSource rootPage)) + html <- + expectRight + (Html.renderDocument + context + hints + renderIndex + rootPage) let supportScript = Html.supportScriptAssetContents assertContains "local references keep page anchors" "href=\"#local_prop\"" html assertContains "local references point previews at the visible target block" "data-reference-label=\"local_prop\" data-preview-target-id=\"local_prop\"" html @@ -111,12 +147,15 @@ renderSynthetic blocks = do (htmlRenderContext layout (sourceGraphRootSource graph)) + let (renderIndex, page :| _remainingPages) = + Html.buildRenderIndex + ((sourceGraphRootSource graph, blocks) :| []) expectRight (Html.renderDocument context "" - blocks - [(sourceGraphRootSource graph, blocks)]) + renderIndex + page) expectRight :: (Show e, HasCallStack) => Either e a -> IO a expectRight = \case |