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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
{-# LANGUAGE OverloadedStrings
, ImportQualifiedPost
#-}
module Handlingar.TexOutput
( handleTex
) where
import Control.Monad.State.Lazy
import Data.Default (def)
import Data.Map.Lazy qualified as Map
import Data.String (IsString(fromString))
import Data.Text (Text, pack, unpack)
import Data.Text.IO qualified as T
import Handlingar.Common (handleBilagaHeading, getVimwikiPage, handleMailLink, handleBlocks, replaceLinks, uriChars)
import Network.URI (parseURI, uriScheme, uriPath)
import Network.URI.Encode (encodeWith, decode)
import System.Directory (makeAbsolute, createDirectoryIfMissing, copyFile)
import System.FilePath (takeExtension, (<.>), takeBaseName)
import System.Process (createProcess, shell, CreateProcess(cwd), waitForProcess)
import Tex (toTex, TeX (..))
import Text.DocTemplates (toVal, Val(SimpleVal, ListVal), Context(Context))
import Text.Pandoc (readVimwiki, WriterOptions(writerTemplate, writerListings, writerVariables), PandocMonad, PandocIO)
import Text.Pandoc.Builder
import Text.Pandoc.Extract (AppendixItem, getHeadingData)
import Text.Pandoc.Templates (compileDefaultTemplate)
import Text.Pandoc.Writers.LaTeX (writeLaTeX)
import Text.URI.Decode (urlDecode)
import Util (joinBy, uncurry3, (<&>))
buildPrimary :: PandocMonad m
=> Pandoc
-> m (Pandoc, [AppendixItem])
buildPrimary (Pandoc meta blocks) = do
-- Pandoc meta blocks <- reader def text
-- let Just blocks = getHeadingData heading blocks
(heading, kvs, wantedBlocks') <- handleBlocks blocks
let (pandoc, appendices) = replaceLinks $ Pandoc meta wantedBlocks'
let pandoc' = foldl (flip . uncurry $ setMeta) pandoc
$ ("title", heading) : kvs
return (pandoc', appendices)
handleFileTex :: FilePath -> String -> PandocIO (Maybe [Block])
handleFileTex fname ".txt" = do
text <- liftIO $ T.readFile fname
return . Just $ [CodeBlock ("", [], []) text]
handleFileTex fname ".pdf" = do
aname <- liftIO $ makeAbsolute fname
let pagecmd = [ TexCmd "thispagestyle" [] ["fancy"]
, TexCmd "lhead" [] ["Bilaga \\Alph{section}.\\arabic{subsection}"]]
let arg = [ "frame"
, "pages={-}"
, "width=\\textwidth"
, "pagecommand=" <> mconcat (fmap toTex pagecmd)]
let lines = [ TexCmd "phantomsection" [] []
, TexCmd "stepcounter" [] ["subsection"]
, TexCmd "includepdf" [joinBy "," arg] [pack . decode $ aname] ]
let inline = RawInline
(Format "latex")
(mconcat $ fmap toTex lines)
return . Just $ [ Plain [ inline ] ]
handleFileTex 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
handleFileTex (dest ++ "/doc.pdf") ".pdf"
-- return . Just $ [ Plain [ Str . pack $ "TEX compiled " ++ dest ] ]
-- handleFileTex fname _ = return . Just $ [Para [Str . pack $ fname]]
handleFileTex fname _ = do
text <- liftIO $ T.readFile fname
return . Just $ [CodeBlock ("", [], []) text]
-- https://www.w3.org/Protocols/rfc1341/7_2_Multipart.html
-- TODO differentiate between inline images (through cid:<> urls), and
-- unrelated attachements
-- See also: Html rebuildLinks
handleBilagaTex :: [Block] -> Text -> PandocIO (Maybe [Block])
handleBilagaTex currentPage url = case parseURI . encodeWith (`elem` uriChars) . unpack $ url of
Just uri -> case uriScheme uri of
('w':'n':'.':wikiname) -> return . Just $ [Para [Str $ "Interwiki" <> pack wikiname]]
"file:" -> do
let (Just fname) = urlDecode $ uriPath uri
liftIO $ do
print $ "raw = " ++ uriPath uri
print $ "fname = " ++ fname
handleFileTex fname $ takeExtension fname
"mail:" -> Just <$> handleMailLink uri
_ -> return $ Just [Para [Str . pack . show $ uri]]
Nothing -> case break (== '#') (unpack url) of
("", '#':frag) -> return $ getHeadingData (pack frag) currentPage
(page, '#':frag) -> getVimwikiPage (page <.> "wiki") <&> getHeadingData (pack frag)
(page, "") -> Just <$> getVimwikiPage (page <.> "wiki")
_ -> return $ Just [Para [Str "ERROR"]]
f :: [Block] -> [Inline] -> Text -> Text -> PandocIO [Block]
f bs is a b = do
let bg = handleBilagaHeading is a
mxs <- handleBilagaTex bs b
case mxs of
Just xs -> return $ bg : xs
Nothing -> return []
handleTex :: Text -> String -> PandocIO Text
handleTex source_text heading = do
texTemplate <- compileDefaultTemplate "latex"
Pandoc m' og_bs <- readVimwiki def source_text
let Just better_blocks = getHeadingData (pack heading) og_bs
-- TODO limit to only relevant heading
(Pandoc meta bs, appendices) <- buildPrimary (Pandoc m' better_blocks)
-- apx <- mconcat $ mapM handleBilagaTex $ reverse appendicies
-- TODO this bs should be the initial source, NOT
-- the result of buildPrimary
fragments <- mapM (uncurry3 (f og_bs)) $ reverse appendices
let apx = mconcat fragments
let trail = [ RawBlock (Format "latex") "\\appendix" ] <> apx
let content = Pandoc meta $ bs <> trail
let opts = [ ("boxlinks", toVal True)
, ("colorlinks", toVal True)
, ("papersize", SimpleVal "a4")
, ("numbersections", toVal True)
, ("lang", SimpleVal "swedish")
, ("header-includes", ListVal $ fmap (SimpleVal . fromString . unpack . toTex) [
TexPackage "pdfpages" -- including PDF's
, TexPackage "fancyhdr" -- page headers on included pdf pages
, TempletizedTexPackage ["most"] "tcolorbox" -- for blockquotes
, LstSet [ ("breaklines", "true")
, ("basicstyle", "\\scriptsize") ]
, TexCmd "newtcolorbox" [] ["myquote", joinBy "," [ "breakable"
, "colback=red!5!white"
, "colframe=red!75!black" ]]
, TexCmd "renewenvironment" [] ("quote" : fmap toTex [
TexCmd "begin" [] ["myquote"]
, TexCmd "end" [] ["myquote"]
])
])
]
writeLaTeX (def { writerTemplate = Just texTemplate
, writerListings = True
, writerVariables = Context $ Map.fromList opts }) content
|
