Commit ee2ff226 authored by Armin Bernstetter's avatar Armin Bernstetter
Browse files

improved decker pdf. index.html does not show pdfs if not available (currently...

improved decker pdf. index.html does not show pdfs if not available (currently shows only when refreshed via decker html or server. needs to be fixed)
parent 7d510317
......@@ -49,6 +49,14 @@ main = do
let indexSource = (directories ^. project) </> "index.md"
let index = (directories ^. public) </> "index.html"
let cruft = ["index.md.generated", "log", "//.shake", "generated", "code"]
let pdfMsg =
"\n# Make sure you have run 'decker html' first.\n" ++
"# To use 'decker pdf' or 'decker pdf-decks', Google Chrome has to be installed.\n" ++
"# Windows: Follow the Google Chrome installer instructions.\n" ++
"# MacOS: Follow the Google Chrome installer instructions.\n" ++
"\tGoogle Chrome.app has to be located in either /Applications/Google Chrome.app or /Users/<username>/Applications/Google Chrome.app\n" ++
"\tAlternatively you can add 'chrome' to $PATH.\n" ++
"# Linux: 'chrome' has to be on $PATH.\n"
--
runDecker $
--
......@@ -75,10 +83,12 @@ main = do
allHtmlA >>= need
--
phony "pdf" $ do
putNormal pdfMsg
need ["index"]
allPdfA >>= need
--
phony "pdf-decks" $ do
putNormal pdfMsg
need ["index"]
decksPdfA >>= need
--
......@@ -119,13 +129,17 @@ main = do
"//*-deck.pdf" %> \out -> do
let src = replaceSuffix "-deck.pdf" "-deck.html" out
need [src]
putNormal $ src ++ " -> " ++ out
putNormal $ "Started: " ++ src ++ " -> " ++ out
runHttpServer serverPort directories Nothing
-- decktape [serverUrl </> makeRelative (directories ^. public) src, out]
result <-
liftIO $
launchChrome
(serverUrl </> makeRelative (directories ^. public) src)
out
case result of
Right msg -> putNormal msg
Left msg -> error msg
--
priority 2 $
"//*-handout.html" %> \out -> do
......
......@@ -100,7 +100,7 @@ library:
source-dirs: src-win
exposed-modules: "System.Decker.OS"
else:
source-dirs: src-mac
source-dirs: src-unix
exposed-modules: "System.Decker.OS"
- condition: flag(preextractedresources)
cpp-options: "-DPREEXTRACTEDRESOURCES"
......
......@@ -22,30 +22,41 @@ preextractedResourceFolder = do
exep <- getExecutablePath
return $ joinPath [(takeDirectory exep), "..", "Resources", "resource"]
-- Look for chromium executable on $PATH
chromeExecutable :: IO String
-- Look for chrome executable on $PATH
chromeExecutable :: IO (Either String String)
chromeExecutable = do
chrium <- findExecutable "chromium"
chr <- findExecutable "chrome"
case (chrium, chr) of
(Just c, _) -> return c
(_, Just c) -> return c
(Nothing, Nothing) ->
error
"Neither chrome nor chromium are on $PATH. Please make sure Google Chrome is installed to use 'decker pdf'."
case chr of
Just c -> return $ Right c
Nothing ->
return $
Left
"'chrome' is not on $PATH. Please make sure 'chrome' is pointing to your Google Chrome installation."
chrome :: IO String
-- Check for MacOS standard installation locations
-- /Applications/Google Chrome.app
-- /Users/<username>/Applications/Google Chrome.app
chrome :: IO (Either String String)
chrome = do
localExists <- localChrome >>= \h -> doesFileExist h
globalExists <- doesFileExist chromeLocation
if globalExists
then return chromeCommand
then return $ Right chromeCommand
else if localExists
then localChromeCommand
else chromeExecutable
else do
exe <- chromeExecutable
case exe of
Right c -> return $ Right c
Left msg ->
return $
Left
("MacOS: Google Chrome.app was not found in /Applications or /User/<username>/Applications. Please install Google Chrome.\n" ++
"Generic Unix: " ++ msg)
where
localChrome = fmap (\h -> h ++ chromeLocation) getHomeDirectory
localChromeCommand = fmap (\h -> h ++ chromeCommand) getHomeDirectory
localChromeCommand =
fmap (\h -> Right (h ++ chromeCommand)) getHomeDirectory
chromeLocation =
"/Applications/Google Chrome.app/Contents/MacOS/Google Chrome"
chromeCommand =
......
......@@ -22,5 +22,6 @@ preextractedResourceFolder = do
exep <- getExecutablePath
return $ joinPath [(takeDirectory exep), "..", "resource"]
chrome :: IO String
chrome = return "start chrome"
-- start chrome from cmd
chrome :: IO (Either String String)
chrome = return $ Right "start chrome"
module Pdf
( getDirs
, launchChrome
( launchChrome
) where
import System.Decker.OS
......@@ -40,47 +39,31 @@ TODO:
require that chrome or chromium is on path
-}
getDirs :: IO ()
getDirs
-- dirs <- getXdgDirectoryList
= do
home <- getHomeDirectory
print home
let apps = "/Applications"
contents <- listDirectory apps
print contents
-- This will be what is imported from the OS module
-- chrome :: FilePath
-- chrome = "/Applications/Google\\ Chrome.app/Contents/MacOS/Google\\ Chrome"
pdfPath = "test.pdf"
pdfOption :: FilePath -> [Char]
pdfOption path = "--print-to-pdf=" ++ path
modifySrc :: FilePath -> FilePath
modifySrc path = path ++ "?print-pdf#/"
-- if isSuffixOf ".html" path
-- then Just $ path ++ "?print-pdf#/"
-- else Nothing
chromeOptions :: FilePath -> FilePath -> [String]
chromeOptions src out =
["--headless", "--disable-gpu", pdfOption out, modifySrc src]
launchChrome :: FilePath -> FilePath -> IO ()
launchChrome :: FilePath -> FilePath -> IO (Either String String)
launchChrome src out = do
command <- chrome
let options = unwords (chromeOptions src out)
-- print options
case command of
Left msg -> return $ Left msg
Right cmd -> do
(_, _, _, ph) <-
createProcess
-- (proc chrome ["--headless", "--disable-gpu", pdfOption out, modifySrc src])
(shell $ command ++ " " ++ options)
createProcess (shell $ cmd ++ " " ++ options) {std_err = CreatePipe}
code <- waitForProcess ph
case code of
ExitFailure _ ->
error
("Error: Google Chrome is most likely not installed." ++
" Make sure Google Chrome is installed to use 'decker pdf'.")
ExitSuccess -> putStrLn $ "completed:" ++ src ++ " -> " ++ out
return $
Left
("Google Chrome is most likely not installed. " ++
"Please install Google Chrome to use 'decker pdf' or 'decker pdf-decks'")
ExitSuccess -> return $ Right ("Completed: " ++ src ++ " -> " ++ out)
......@@ -137,6 +137,9 @@ writeIndexLists out baseUrl = do
let decks = (zip (_decks ts) (_decksPdf ts))
let handouts = (zip (_handouts ts) (_handoutsPdf ts))
let pages = (zip (_pages ts) (_pagesPdf ts))
decksLinks <- mapM makeLink decks
handoutsLinks <- mapM makeLink handouts
pagesLinks <- mapM makeLink pages
liftIO $
writeFile out $
unlines
......@@ -145,19 +148,26 @@ writeIndexLists out baseUrl = do
, "subtitle: " ++ dirs ^. project
, "---"
, "# Slide decks"
, unlines $ map makeLink decks
, unlines $ decksLinks
, "# Handouts"
, unlines $ map makeLink handouts
, unlines $ handoutsLinks
, "# Supporting Documents"
, unlines $ map makeLink pages
, unlines $ pagesLinks
]
where
makeLink (html, pdf) =
printf
makeLink (html, pdf) = do
pdfExists <- doesFileExist pdf
if pdfExists then
return $ printf
"- [%s <i class='fab fa-html5'></i>](%s) [<i class='fas fa-file-pdf'></i>](%s)"
(takeFileName html)
(makeRelative baseUrl html)
(makeRelative baseUrl pdf)
else
return $ printf
"- [%s <i class='fab fa-html5'></i>](%s)"
(takeFileName html)
(makeRelative baseUrl html)
-- | Fixes pandoc escaped # markup in mustache template {{}} markup.
fixMustacheMarkup :: B.ByteString -> T.Text
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment