Cleanup of HtmlOutput.hs

2 files changed, 34 insertions, 45 deletions

diff --git a/hs/src/Handlingar.hs b/hs/src/Handlingar.hs
index 157e95d..b9a0038 100644
--- a/hs/src/Handlingar.hs
+++ b/hs/src/Handlingar.hs
@@ -5,10 +5,9 @@ module Handlingar
 ) where
 
 import System.FilePath (dropFileName)
-import System.Posix.Directory (changeWorkingDirectory, getWorkingDirectory)
 import Text.Pandoc (runIOorExplode)
 import qualified Data.Text.IO as T
-import System.FilePath ((</>))
+import System.Directory (canonicalizePath, createDirectoryIfMissing, withCurrentDirectory)
 
 -- import Handlingar.TexOutput (handleTex)
 import Handlingar.HtmlOutput (handleHtml)
@@ -32,14 +31,12 @@ main :: [String] -> IO ()
 main args = do
     case args of
         [file, heading] -> do
-
-            here <- getWorkingDirectory
-            changeWorkingDirectory $ dropFileName file
+            destination <- canonicalizePath "out"
+            createDirectoryIfMissing True destination
 
             text <- T.readFile file
-            -- TODO mkdir
-            runIOorExplode $ handleHtml text heading (here </> "out")
 
-            changeWorkingDirectory here
+            withCurrentDirectory (dropFileName file) $ do
+                runIOorExplode $ handleHtml text heading destination
 
         _ -> error "Usage: ./main handlingar <input-file> <heading>"
diff --git a/hs/src/Handlingar/HtmlOutput.hs b/hs/src/Handlingar/HtmlOutput.hs
index 320df19..5ca6d7f 100644
--- a/hs/src/Handlingar/HtmlOutput.hs
+++ b/hs/src/Handlingar/HtmlOutput.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings
            , ImportQualifiedPost
+           , ScopedTypeVariables
            #-}
 
 module Handlingar.HtmlOutput
@@ -8,55 +9,43 @@ module Handlingar.HtmlOutput
 
 import Control.Monad.State.Lazy
 import Data.Default (def)
-import Text.Pandoc.Extract (AppendixItem, getHeadingData)
-import Text.Pandoc (readVimwiki, PandocIO)
-import Text.Pandoc.Definition (Meta(..))
-import Text.Pandoc.Builder
+import Data.Map.Strict qualified as Map
+import Data.String (fromString)
 import Data.Text (Text, unpack, pack)
-import Text.Pandoc.Writers.HTML (writeHtml5String)
-import Handlingar.Common (handleBilaga, HandlingarOps(..), buildPrimary)
-import System.FilePath ((</>), takeExtension)
-import Data.Text.IO (writeFile)
 import Data.Text qualified as T
-import System.Directory (copyFile)
-import System.Posix.Directory (changeWorkingDirectory, getWorkingDirectory)
-import Control.Exception (catch)
-import Data.Map.Strict qualified as Map
-import Text.DocTemplates (compileTemplateFile)
-import Text.Pandoc.Templates ( Template(..), getTemplate, renderTemplate, WithDefaultPartials(..))
-import Text.DocTemplates ()
-import Text.Pandoc (readVimwiki, WriterOptions(writerTemplate, writerListings, writerVariables), PandocIO)
-import System.Process (createProcess, shell, CreateProcess(cwd), waitForProcess)
+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 (takeBaseName)
+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 (link_text, _, target) = do
+handleAppendix ops source_blocks (_, _, target) = do
     mxs <- handleBilaga ops source_blocks target
     case mxs of 
         Just xs -> do
-            liftIO $ putStrLn $ "target: " ++ show target
-            liftIO $ getWorkingDirectory >>= putStrLn
             case takeExtension . unpack $ target of
                 "" -> return ()
                 _  -> liftIO $ copyFile (unpack . T.drop 5 $ target) (destination ops </> (unpack . sourceToTarget' $ target))
-            -- liftIO $ catch (copyFile (unpack target) (destination ops </> (unpack . sourceToTarget' $ target))) (\_ -> (copyFile (unpack target <> ".wiki") (destination ops </> (unpack . sourceToTarget' $ target))))
 
-            liftIO $ print xs
-            -- template' <- getTemplate "html.template"
-            -- res' <- compileTemplate "html.template" template'
             res' <- liftIO $ compileTemplateFile "/home/hugo/code/vimwiki-scripts/hs/html.template"
             let res = case res' of
                                 Left _ -> Nothing
                                 Right x -> Just x
-            liftIO . putStrLn $ "template: " ++ show res
-            -- let template = renderTemplate templateData
             out <- writeHtml5String (def { writerTemplate = res }) (Pandoc (Meta Map.empty) xs)
             liftIO $ writeFile (destination ops </> (unpack . sourceToTarget $ target))
                                (out)
-                               -- (pack . show $ xs)
             return []
         Nothing -> return []
 
@@ -72,7 +61,7 @@ sourceToTarget :: Text -> Text
 sourceToTarget source = sourceToTarget' source <> ".html"
 
 rewriteLinkHtml :: Inline -> State [AppendixItem] Inline
-rewriteLinkHtml x@(Link _ displayed (target, "wikilink")) = do
+rewriteLinkHtml (Link _ displayed (target, "wikilink")) = do
     modify ((displayed, "", target):)
     return $ Link ("", [], []) 
                   (displayed <> [Superscript [Str "(bilaga)"]])
@@ -89,7 +78,16 @@ handleFileHtml fname ".tex" = do
     (_, _, _, handle) <- liftIO $ createProcess ((shell "latexmk -pdf doc") { cwd = Just dest })
     liftIO $ waitForProcess handle
     handleFileHtml (dest ++ "/doc.pdf") ".pdf"
-handleFileHtml fname ".pdf" = return . Just $ [ Plain [ RawInline (Format "html") ("<object type=\"application/pdf\" data=\"" <> (sourceToTarget' . pack $ fname) <> "\">PDF Failed loading</object>") ] ]
+
+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) ]]
@@ -106,13 +104,7 @@ handleHtml source_text heading destination = do
   let Just better_blocks = getHeadingData (pack heading) og_bs
   (Pandoc meta bs, appendices) <- buildPrimary ops (Pandoc m' better_blocks)
 
-  liftIO $ putStrLn $ "meta: " ++ show meta
-  liftIO $ putStrLn $ "count appendies: " ++ show (length appendices)
-  -- liftIO $ putStrLn $ "count appendies: " ++ show appendices
-
-  fragments <- mapM (handleAppendix ops og_bs) $ reverse appendices
-  let apx = mconcat fragments
-  liftIO $ putStrLn $ "apx: " ++ show apx
+  mapM_ (handleAppendix ops og_bs) $ reverse appendices
   let content = Pandoc meta bs
 
   res' <- liftIO $ compileTemplateFile "/home/hugo/code/vimwiki-scripts/hs/html.template"