HTML writer: fallback to basename rather than Untitled.

This commit is contained in:
John MacFarlane 2017-03-09 09:41:22 +01:00
parent fd35661646
commit 239a17a986
3 changed files with 7 additions and 6 deletions

View file

@ -76,7 +76,7 @@ import qualified Text.Blaze.Html5 as H5
#endif
import Control.Monad.Except (throwError)
import Data.Aeson (Value)
import System.FilePath (takeExtension)
import System.FilePath (takeExtension, takeBaseName)
import Text.Blaze.Html.Renderer.String (renderHtml)
import qualified Text.Blaze.XHtml1.Transitional as H
import qualified Text.Blaze.XHtml1.Transitional.Attributes as A
@ -197,9 +197,10 @@ writeHtmlString' st opts d = do
case getField "pagetitle" context of
Just (s :: String) | not (null s) -> return context
_ -> do
report $ NoTitleElement "Untitled"
return $ resetField "pagetitle" ("Untitled" :: String)
context
let fallback = fromMaybe "Untitled" $ takeBaseName <$>
lookup "sourcefile" (writerVariables opts)
report $ NoTitleElement fallback
return $ resetField "pagetitle" fallback context
return $ renderTemplate' tpl $
defField "body" (renderHtml body) context'

View file

@ -4,7 +4,7 @@
<meta charset="utf-8" />
<meta name="generator" content="pandoc" />
<meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes" />
<title>Untitled</title>
<title>lhs-test</title>
<style type="text/css">
code{white-space: pre-wrap;}
.smallcaps{font-variant: small-caps;}

View file

@ -4,7 +4,7 @@
<meta charset="utf-8" />
<meta name="generator" content="pandoc" />
<meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes" />
<title>Untitled</title>
<title>lhs-test</title>
<style type="text/css">
code{white-space: pre-wrap;}
.smallcaps{font-variant: small-caps;}