1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
{-# LANGUAGE OverloadedStrings
, ImportQualifiedPost
, ScopedTypeVariables
#-}
module Handlingar.HtmlOutput
( handleHtml
) where
import Control.Monad.State.Lazy
import Data.Default (def)
import Data.Map.Strict qualified as Map
import Data.String (fromString)
import Data.Text (Text, unpack, pack)
import Data.Text qualified as T
import Data.Text.IO (writeFile)
import Data.Text.Lazy (toStrict)
import Handlingar.Common (handleBilaga, HandlingarOps(..), buildPrimary)
import System.Directory (makeAbsolute, createDirectoryIfMissing, copyFile)
import System.FilePath ((</>), takeExtension, takeBaseName)
import System.Process (createProcess, shell, CreateProcess(cwd), waitForProcess)
import Text.Blaze.Html5 (Html(), object, a, (!))
import Text.Blaze.Html5.Attributes (data_, type_, href)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Text.DocTemplates (compileTemplateFile)
import Text.Pandoc (readVimwiki, WriterOptions(writerTemplate), PandocIO)
import Text.Pandoc.Builder
import Text.Pandoc.Extract (AppendixItem, getHeadingData)
import Text.Pandoc.Writers.HTML (writeHtml5String)
import Prelude hiding (writeFile)
handleAppendix :: HandlingarOps -> [Block] -> AppendixItem -> PandocIO [Block]
handleAppendix ops source_blocks (_, _, target) = do
mxs <- handleBilaga ops source_blocks target
case mxs of
Just xs -> do
case takeExtension . unpack $ target of
"" -> return ()
_ -> liftIO $ copyFile (unpack . T.drop 5 $ target) (destination ops </> (unpack . sourceToTarget' $ target))
res' <- liftIO $ compileTemplateFile "/home/hugo/code/vimwiki-scripts/hs/html.template"
let res = case res' of
Left _ -> Nothing
Right x -> Just x
out <- writeHtml5String (def { writerTemplate = res }) (Pandoc (Meta Map.empty) xs)
liftIO $ writeFile (destination ops </> (unpack . sourceToTarget $ target))
(out)
return []
Nothing -> return []
sourceToTarget' :: Text -> Text
sourceToTarget' source
| "file:" == T.take 5 source = proc $ T.drop 5 source
| otherwise = proc source
where proc s = T.replace "/" "-" s
-- Convert a link wikilink from the source document to an html link in
-- the destination document
sourceToTarget :: Text -> Text
sourceToTarget source = sourceToTarget' source <> ".html"
rewriteLinkHtml :: Inline -> State [AppendixItem] Inline
rewriteLinkHtml (Link _ displayed (target, "wikilink")) = do
modify ((displayed, "", target):)
return $ Link ("", [], [])
(displayed <> [Superscript [Str "(bilaga)"]])
(sourceToTarget target, "") -- TODO write something nice for title
rewriteLinkHtml x = return x
-- TODO this is probably where we should create the included files
handleFileHtml :: FilePath -> String -> PandocIO (Maybe [Block])
handleFileHtml fname ".tex" = do
aname <- liftIO $ makeAbsolute fname
let dest = "/tmp/vimwiki-script/" ++ (takeBaseName aname)
liftIO $ createDirectoryIfMissing True dest
liftIO (copyFile aname $ dest ++ "/doc.tex")
(_, _, _, handle) <- liftIO $ createProcess ((shell "latexmk -pdf doc") { cwd = Just dest })
liftIO $ waitForProcess handle
handleFileHtml (dest ++ "/doc.pdf") ".pdf"
handleFileHtml fname ".pdf" = do
let uri = fromString . unpack . sourceToTarget' . pack $ fname
let pdfobj :: Html = object ! type_ "application/pdf"
! data_ uri
$ a ! href uri $ "PDF failed to load, try source: " -- <> uri
let pdfobj' :: Text = toStrict . renderHtml $ pdfobj
return . Just $ [ Plain [ RawInline (Format "html")
(pdfobj') ] ]
handleFileHtml fname _ = do
dat <- liftIO $ readFile fname
return . Just $ [ Plain [ Code ("", [], []) (pack dat) ]]
handleHtml :: Text -> String -> FilePath -> PandocIO ()
handleHtml source_text heading destination = do
let ops = HandlingarOps { handleFile = handleFileHtml
, rewriteLink = rewriteLinkHtml
, destination = destination
}
Pandoc m' og_bs <- readVimwiki def source_text
let Just better_blocks = getHeadingData (pack heading) og_bs
(Pandoc meta bs, appendices) <- buildPrimary ops (Pandoc m' better_blocks)
mapM_ (handleAppendix ops og_bs) $ reverse appendices
let content = Pandoc meta bs
res' <- liftIO $ compileTemplateFile "/home/hugo/code/vimwiki-scripts/hs/html.template"
let res = case res' of
Left _ -> Nothing
Right x -> Just x
result <- writeHtml5String (def { writerTemplate = res }) content
liftIO $ writeFile (destination </> "index.html") result
|
