diff --git a/src/Tintin/Domain/Project.hs b/src/Tintin/Domain/Project.hs --- a/src/Tintin/Domain/Project.hs +++ b/src/Tintin/Domain/Project.hs @@ -36,3 +36,12 @@ , pages :: [Page] } +data PageRef = PageRef + { refTitle :: Text + , refFilename :: Text + } + +data Context = Context + { prevRef :: Maybe PageRef + , nextRef :: Maybe PageRef + } diff --git a/src/Tintin/Html/Style.hs b/src/Tintin/Html/Style.hs --- a/src/Tintin/Html/Style.hs +++ b/src/Tintin/Html/Style.hs @@ -29,6 +29,10 @@ h2 ? fontSize (em 1.953) h3 ? fontSize (em 1.563) + ".next-prev" ? do + marginTop (pct 5) + marginBottom (pct 5) + "#header-container" ? do marginTop (rem 5) marginBottom (rem 5) diff --git a/src/Tintin/Html/Templating.hs b/src/Tintin/Html/Templating.hs --- a/src/Tintin/Html/Templating.hs +++ b/src/Tintin/Html/Templating.hs @@ -15,15 +15,15 @@ asset :: Text -> Text asset txt = "https://s3-eu-west-1.amazonaws.com/worldwideapps/assets/" <> txt -wrap :: Project.Info -> Project.Page -> Text -wrap info page = +wrap :: Project.Info -> Project.Context -> Project.Page -> Text +wrap info context page = if (Project.filename page) == "index.html" - then wrapHome info page - else wrapPage info page + then wrapHome info (Project.nextRef context) page + else wrapPage info context page -wrapPage :: Project.Info -> Project.Page -> Text -wrapPage info page = toText . renderText $ do +wrapPage :: Project.Info -> Project.Context -> Project.Page -> Text +wrapPage info context page = toText . renderText $ do doctypehtml_ $ do tintinHeader info page body_ [class_ "h-100 tintin-fg-black tintin-bg-white"] $ do @@ -58,10 +58,23 @@ div_ [ class_ "animated fadeIn" ] $ toHtmlRaw $ Project.content page - div_ [class_ "tintin-doc-footer clear-fix"] + div_ [class_ "tintin-doc-footer clear-fix"] $ do + nextPrev context siteGenerated tintinPostInit +nextPrev :: Project.Context -> Html () +nextPrev context = do + div_ [class_ "row next-prev"] $ do + whenJust (Project.prevRef context) $ \prev -> do + div_ [class_ "col-md-4 offset-md-4"] $ do + a_ [href_ $ Project.refFilename prev] $ do + ( toHtml $ "< Previous: " <> Project.refTitle prev ) + whenJust (Project.nextRef context) $ \next -> do + div_ [class_ "col-md-4 ml-auto"] $ do + a_ [href_ $ Project.refFilename next] $ do + ( toHtml $ "Next: " <> Project.refTitle next <> " >") + siteGenerated = do div_ [class_ "float-right"] $ do div_ [class_ "d-inline", style_ "float: left"] $ do @@ -73,9 +86,8 @@ a_ [class_ "float:left", href_ "http://theam.io"] $ img_ [class_ "footer-theam", src_ "http://theam.io/logo_theam.png"] - -wrapHome :: Project.Info -> Project.Page -> Text -wrapHome info page = toText . renderText $ do +wrapHome :: Project.Info -> Maybe Project.PageRef -> Project.Page -> Text +wrapHome info nextRef page = toText . renderText $ do doctypehtml_ $ do tintinHeader info page body_ [class_ "tintin-fg-black tintin-bg-white"] $ do @@ -101,6 +113,7 @@ ] $ div_ [] $ do toHtmlRaw $ Project.content page + nextPrev (Project.Context Nothing nextRef) footer tintinPostInit where diff --git a/src/Tintin/Render.hs b/src/Tintin/Render.hs --- a/src/Tintin/Render.hs +++ b/src/Tintin/Render.hs @@ -11,6 +11,7 @@ require Tintin.Html.Templating require Tintin.Errors +require Data.Map require Data.Text data Render @@ -41,9 +42,76 @@ writeOutput (OutputDirectory od) info = do Filesystem.makeDirectory (Filesystem.Path od) Logging.debug "Writing HTML output" - forM_ (Project.pages info) $ \page -> do - let newContent = Templating.wrap info page + forM_ (withContext (Project.pages info)) $ \(page, context) -> do + let newContent = Templating.wrap info context page let slash = if "/" `Text.isSuffixOf` od then "" else "/" Filesystem.writeFile (Filesystem.Path $ od <> slash <> Project.filename page) newContent - +-- | Pair up each page with context (next and previous links) by +-- alphabetical order, excluding index page. +-- +-- This function is a little more complicated than might be expected +-- because the functionality is a little nuanced. It has to: +-- +-- 1. Pair each page with next and previous links based on an alphabetical +-- sorting, /excluding/ the index page. +-- 2. Give the /first/ non-index page, alphabetically, a "previous" link +-- pointing to the index /if it exists/. +-- 3. Give the index, if it exists, a "next' link to the first non-index +-- page. +-- +withContext + :: [Project.Page] + -> [(Project.Page, Project.Context)] +withContext ps = elems contextMap + where + -- | Pre-processing function. Using a single fold, pick out the index + -- page link (if it exists) and also accumulate a Map of all non-index + -- pages, keyed by filenames. The map enforces that the filenames are + -- stored alphabetically. + indexRef :: Maybe Project.PageRef + pageMap :: Map Text Project.Page + (First indexRef, pageMap) + = foldMap (\p -> let fn = Project.filename p + in if fn == "index.html" + then (First (Just (makeRef p)), mempty ) + else (mempty , one (fn, p)) + ) ps + -- | Accumulate a final result map pairing each file with its + -- 'makeContext' result. The keys are the filenames, to enforce + -- alphabetical sorting. + contextMap :: Map Text (Project.Page, Project.Context) + contextMap = ps + |$> (\p -> (Project.filename p, (p, makeContext p))) + |> Map.fromList + -- | Actual function that pairs up each page with its context (next and + -- previous links). + -- + -- If the page is "index.html", use just the first item in 'pageMap', + -- the map of non-index pages, using 'Map.lookupMin' + -- + -- Otherwise, use 'Map.lookupLT' and 'Map.lookupGT' to find the "next + -- and previous" pages in 'pageMap' (the map of non-index pages). And, + -- if there is no previous page, use the index page instead. + makeContext :: Project.Page -> Project.Context + makeContext p + | fn == "index.html" = Map.lookupMin pageMap + |$> snd + |$> makeRef + |> Project.Context Nothing + | otherwise = + let prev = Map.lookupLT fn pageMap + |$> snd + |$> makeRef + next = Map.lookupGT fn pageMap + |$> snd + |$> makeRef + in Project.Context (prev <|> indexRef) next -- if no prev, use index + where + fn = Project.filename p + -- | Construct a link/reference from a page. + makeRef :: Project.Page -> Project.PageRef + makeRef p = Project.PageRef + { refTitle = Project.title p + , refFilename = Project.filename p + } diff --git a/tintin.cabal b/tintin.cabal --- a/tintin.cabal +++ b/tintin.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: b3692d295c2965f34521bb49cc143434b43e61fef217860c4836606544e5fca6 +-- hash: 7647be86161169e6a64d48e037232b667bc54e1e83088decea8738f17b5137ff name: tintin -version: 1.8.0 +version: 1.9.0 synopsis: A softer alternative to Haddock description: Please see the website category: Documentation @@ -54,6 +54,7 @@ build-depends: base >=4.7 && <5 , clay + , containers , data-has , directory , frontmatter