Major work on Handlingar.

2 files changed, 94 insertions, 12 deletions

diff --git a/hs/src/Handlingar.hs b/hs/src/Handlingar.hs
index e6d2d96..929ed4a 100644
--- a/hs/src/Handlingar.hs
+++ b/hs/src/Handlingar.hs
@@ -4,17 +4,38 @@ module Handlingar
 ( main
 ) where
 
+import Prelude hiding
+    ( putStrLn
+    , writeFile
+    )
+
 import Text.Pandoc
     ( runIOorExplode
     , readVimwiki
+    , WriterOptions(writerTemplate, writerVariables)
+    , PandocMonad
+    , writePlain
+    , ReaderOptions
     )
 import Text.Pandoc.Builder
-import Data.Text (Text, pack)
+import Text.Pandoc.Writers.LaTeX (writeLaTeX)
+import Text.Pandoc.Templates
+    ( compileDefaultTemplate
+    )
+import Text.Pandoc.Walk (walkM)
+import Data.Text (Text, pack, strip)
+import Data.Text.IO
+    ( putStrLn
+    , writeFile
+    )
 import System.Environment (getArgs)
 import Data.Default (def)
-
+import Control.Monad.State.Lazy
+import Data.Text.Encoding.Base64 (encodeBase64)
+import Text.DocTemplates (toVal, Val(SimpleVal), Context(Context))
 
 import qualified Data.Text.IO as T
+import qualified Data.Map.Lazy as Map
 
 
 oneOf :: (a -> Bool) -> (a -> Bool) -> a -> Bool
@@ -50,20 +71,77 @@ getHeadingData heading blocks =
                           remaining
     in head : items
 
+extractKV :: PandocMonad m => [Inline] -> [[Block]] -> m (Text, Text)
+extractKV is bbs = do
+    key <- strip <$> writePlain def (Pandoc nullMeta [Plain is])
+    value <- mconcat <$> mapM (fmap strip . writePlain def . Pandoc nullMeta) bbs
+    return (key, value)
+
+handleBlocks :: PandocMonad m => [Block] -> m (Text, [(Text, Text)], [Block])
+handleBlocks (head:DefinitionList definitions:blocks) = do
+    heading <- writePlain def (Pandoc nullMeta [head])
+    kvs <- mapM (uncurry extractKV) definitions
+    return (strip heading, kvs, blocks)
+handleBlocks (head:blocks) = do
+    heading <- writePlain def (Pandoc nullMeta [head])
+    return (strip heading, [], blocks)
+handleBlocks blocks = return ("Heading missing", [], blocks)
+
+buildPrimary :: PandocMonad m
+             => (ReaderOptions -> Text -> m Pandoc)
+             -> Text
+             -> Text
+             -> m (Pandoc, [([Inline], Text, Text)])
+buildPrimary reader heading text = do
+    Pandoc meta blocks <- reader def text
+    (heading, kvs, wantedBlocks') <- handleBlocks $ getHeadingData heading blocks
+    let (pandoc, appendices) = replaceLinks $ Pandoc meta wantedBlocks'
+
+    let pandoc' = foldl (flip . uncurry $ setMeta) pandoc
+                $ ("title", heading) : kvs
+    return (pandoc', appendices)
+
+rewriteLink :: Inline -> State [([Inline], Text, Text)] Inline
+rewriteLink (Link _ is (target, "wikilink")) = do
+    let appendixRef = encodeBase64 target
+    let txt = [ Str "(bilaga"
+              , RawInline (Format "latex")
+                          ("~\\ref{bilaga:" <> appendixRef <> "}")
+              , Str ")"
+              ]
+    let lnk = Link ("", [], [ ("reference-type", "ref")
+                            , ("reference", "bilaga:" <> appendixRef) ])
+                   (is <> [Superscript txt])
+                   ( "#bilaga:" <> appendixRef, "" )
+    modify ((is, appendixRef, target):)
+    return lnk
+rewriteLink x = return x
+
+replaceLinks :: Pandoc -> (Pandoc, [([Inline], Text, Text)])
+replaceLinks = flip runState [] . walkM rewriteLink
 
 main = do
     args <- getArgs
     case args of
         [file, heading] -> do
-            putStrLn $ "Heading = " <> heading
+
             text <- T.readFile file
 
-            -- html <- handleSourceText text
-            pandoc <- runIOorExplode $ readVimwiki def text
-            let Pandoc _ blocks = pandoc
-            -- putStr . valToStr $ blocks
-            mapM_ print $ getHeadingData (pack heading) blocks
-            -- let htmlString = toStrict . renderHtml $ html
-            -- liftIO $ T.writeFile outTarget htmlString
-        _ -> error "Invalid command line"
-            
+            tex <- runIOorExplode $ do
+                texTemplate <- compileDefaultTemplate "latex"
+                (Pandoc meta bs, appendices) <- buildPrimary readVimwiki (pack heading) text
+                let apx = appendices >>= (\(is, a, b) -> [Header 1 ("bilaga:" <> a, [], []) is, Plain [Str b]])
+                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")
+                           ]
+                writeLaTeX (def { writerTemplate = Just texTemplate
+                                , writerVariables = Context $ Map.fromList opts }) content
+
+            writeFile "out.tex" tex
+            putStrLn "Wrote result to out.tex"
+        _ -> error "Usage: ./main handlingar <input-file> <heading>"
diff --git a/hs/vimwiki.cabal b/hs/vimwiki.cabal
index d60b225..eb50315 100644
--- a/hs/vimwiki.cabal
+++ b/hs/vimwiki.cabal
@@ -39,18 +39,22 @@ executable Main
     System.FilePath.Normalize
   build-depends:
     base                 >= 4.8,
+    base64               >= 0.4,
     blaze-html           >= 0.9,
     blaze-markup         >= 0.8.2.7,
     containers           >= 0.5,
     data-default         >= 0.7,
     directory            >= 1.3.6,
+    doctemplates         >= 0.11,
     filepath             >= 1.4.2,
     ini                  >= 0.4.2,
     lens                 >= 5.1,
+    mtl                  >= 2.2,
     network-uri          >= 2.6.4,
     optparse-applicative >= 0.17,
     pandoc               >= 2.19,
     pandoc-types         >= 1.22,
+    process              >= 1.6,
     text                 >= 1.2.2,
     unix                 >= 2.7.2,
     uri-encode           >= 1.5.0,