From 72131284828405cad661a8eca424ae30d06ef668 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Wed, 11 Oct 2023 23:43:41 +0200 Subject: Cleanup of HtmlOutput. --- hs/src/Handlingar.hs | 13 ++++---- hs/src/Handlingar/HtmlOutput.hs | 66 ++++++++++++++++++----------------------- 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 " 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") (" (sourceToTarget' . pack $ fname) <> "\">PDF Failed loading") ] ] + +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" -- cgit v1.2.3