Commit c4f81032 authored by Henrik Tramberend's avatar Henrik Tramberend
Browse files

Use `decker check` to check for external programs

parent 45b43f61
......@@ -10,6 +10,7 @@ import Data.Maybe
import Data.String ()
import Development.Shake
import Development.Shake.FilePath
import External
import GHC.Conc (numCapabilities)
import Project
import Resources
......@@ -99,14 +100,7 @@ main = do
need [src]
putNormal $ src ++ " -> " ++ out
runHttpServer serverPort dirs Nothing
code <-
cmd
"decktape.sh reveal"
(serverUrl </> makeRelative publicDir src)
out
case code of
ExitFailure _ -> throw $ DecktapeException "Unknown."
ExitSuccess -> return ()
decktape [(serverUrl </> makeRelative publicDir src), out]
--
priority 2 $
"//*-handout.html" %> \out -> do
......@@ -148,17 +142,14 @@ main = do
"//*.dot.svg" %> \out -> do
let src = dropExtension out
need [src]
cmd "dot -Tsvg" ("-o" ++ out) src
dot [("-o" ++ out), src]
-- cmd "dot -Tsvg" ("-o" ++ out) src
--
priority 2 $
"//*.gnuplot.svg" %> \out -> do
let src = dropExtension out
need [src]
cmd
"gnuplot -d"
["-e", "set terminal svg"]
["-e", "set output \"" ++ out ++ "\""]
src
gnuplot ["-e", "set output \"" ++ out ++ "\"", src]
--
priority 2 $
"//*.tex.svg" %> \out -> do
......@@ -166,13 +157,8 @@ main = do
let pdf = src -<.> ".pdf"
let dir = takeDirectory src
need [src]
() <-
cmd
"pdflatex -halt-on-error -interaction batchmode"
["-output-directory", dir]
src
() <- cmd "pdf2svg" pdf out
cmd "rm" pdf
pdflatex ["-output-directory", dir, src]
pdf2svg [pdf, out]
--
phony "clean" $ do
removeFilesAfter publicDir ["//"]
......@@ -194,9 +180,10 @@ main = do
putNormal "targets:"
everythingA <++> everythingPdfA >>= mapM_ putNormal
--
-- phony "support" $ writeEmbeddedFiles deckerSupportDir supportDir
phony "support" $ do liftIO $ writeResourceFiles "support" supportDir
--
phony "check" checkExternalPrograms
--
phony "publish" $ do
need ["support"]
everythingA <++> indexA >>= need
......@@ -207,11 +194,8 @@ main = do
then do
let src = publicDir ++ "/"
let dst = intercalate ":" [fromJust host, fromJust path]
cmd "ssh " (fromJust host) "mkdir -p" (fromJust path) :: Action ()
cmd
"rsync --recursive --no-xattrs --no-group --perms --chmod=a+r,go-w --no-owner --copy-links"
src
dst :: Action ()
ssh [(fromJust host), "mkdir -p", (fromJust path)]
rsync [src, dst]
else throw RsyncUrlException
-- Calculate some directories
......
......@@ -4,7 +4,7 @@ synopsis: All inclusive slide deck creation with pandoc.
description: Please see README.md
homepage: https://tramberend.beuth-hochschule.de/decker
license: OtherLicense
license-file: LICENSE
license-file: LICENSE
author: Henrik Tramberend
maintainer: tramberend@beuth-hochschule.de
copyright: 2017 Henrik Tramberend
......@@ -22,12 +22,28 @@ cabal-version: >=1.10
executable decker
hs-source-dirs: app, src
main-is: decker.hs
other-modules: Action, Cache, CRC32, Meta, Watch, Embed, Context, Utilities, Filter, Project, Common, Server, Resources, Render, Paths_decker
other-modules: Action
, Cache
, CRC32
, Meta
, Watch
, Embed
, Context
, Utilities
, Filter
, Project
, Common
, Server
, Resources
, Render
, External
, Paths_decker
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
, Glob
, HTTP
, aeson
, ansi-terminal
, array
, base64-bytestring
, blaze-html
......
......@@ -23,6 +23,7 @@ data DeckerException
| HttpException String
| RsyncUrlException
| DecktapeException String
| ExternalException String
deriving (Typeable)
instance Exception DeckerException
......
{-- Author: Henrik Tramberend <henrik@tramberend.de> --}
module External
( ssh
, rsync
, External.unzip
, dot
, gnuplot
, pdflatex
, pdf2svg
, decktape
, checkExternalPrograms
) where
import Common
import Control.Exception
import Data.Maybe
import Development.Shake
import System.Console.ANSI
import System.Exit
import System.Process
data ExternalProgram = ExternalProgram
{ options :: [CmdOption]
, path :: String
, args :: [String]
, testArgs :: [String]
, help :: String
}
programs =
[ ( "ssh"
, ExternalProgram
[]
"ssh"
[]
["-V"]
(helpText "`ssh` program (https://www.openssh.com)"))
, ( "rsync"
, ExternalProgram
[]
"rsync"
[ "--recursive"
, "--no-xattrs"
, "--no-group"
, "--perms"
, "--chmod=a+r,go-w"
, "--no-owner"
, "--copy-links"
]
["--version"]
(helpText "`rsync` program (https://rsync.samba.org)"))
, ( "unzip"
, ExternalProgram
[]
"unzip"
[]
[]
(helpText "`unzip` program (http://www.info-zip.org)"))
, ( "dot"
, ExternalProgram
[]
"dot"
["-Tsvg"]
["-V"]
(helpText "Graphviz package (http://www.graphviz.org)"))
, ( "gnuplot"
, ExternalProgram
[]
"gnuplot"
["-d", "-e", "set terminal svg enhanced mouse"]
["-V"]
(helpText "Gnuplot package (http://gnuplot.sourceforge.net)"))
, ( "pdflatex"
, ExternalProgram
[]
"pdflatex"
["-halt-on-error", "-interaction=batchmode", "-no-shell-escape"]
["--version"]
(helpText "LaTeX type setter (https://www.tug.org/texlive/)"))
, ( "pdf2svg"
, ExternalProgram
[]
"pdf2svg"
[]
[]
(helpText "LaTeX type setter (https://github.com/dawbarton/pdf2svg)"))
, ( "decktape"
, ExternalProgram
[]
"decktape"
["reveal"]
[]
(helpText
"Decktape PDF exporter (https://github.com/astefanutti/decktape)"))
]
type Program = ([String] -> Action ())
ssh :: Program
ssh = makeProgram "ssh"
rsync :: Program
rsync = makeProgram "rsync"
unzip :: Program
unzip = makeProgram "unzip"
dot :: Program
dot = makeProgram "dot"
gnuplot :: Program
gnuplot = makeProgram "gnuplot"
pdflatex :: Program
pdflatex = makeProgram "pdflatex"
pdf2svg :: Program
pdf2svg = makeProgram "pdf2svg"
decktape :: Program
decktape = makeProgram "decktape"
helpText :: String -> String
helpText name =
"The " ++
name ++
" could not be found. Make sure it is installed and available via the `PATH` environment variable."
makeProgram :: String -> ([String] -> Action ())
makeProgram name =
let external = fromJust $ lookup name programs
in (\arguments -> do
(Exit code, Stdout out, Stderr err) <-
command
(options external)
(path external)
(args external ++ arguments)
case code of
ExitSuccess -> return ()
ExitFailure _ ->
throw $
ExternalException $
"\n" ++ (help external) ++ "\n\n" ++ err ++ "\n\n" ++ out)
checkProgram :: String -> Action Bool
checkProgram name = do
liftIO $
handle (\(SomeException e) -> return False) $ do
let external = fromJust $ lookup name programs
(code, out, err) <-
readProcessWithExitCode (path external) (testArgs external) ""
case code of
ExitFailure status
| status == 127 -> return False
_ -> return True
checkExternalPrograms :: Action ()
checkExternalPrograms = putNormal "# external programs:" >> mapM_ check programs
where
check (name, external) = do
result <- checkProgram name
if result
then putNormal $
" " ++
setSGRCode [SetColor Foreground Vivid Blue] ++
name ++
setSGRCode [Reset] ++
": " ++
setSGRCode [SetColor Foreground Vivid Green] ++
"found" ++ setSGRCode [Reset]
else putNormal $
" " ++
setSGRCode [SetColor Foreground Vivid Blue] ++
name ++
setSGRCode [Reset] ++
": " ++
setSGRCode [SetColor Foreground Vivid Red] ++
"missing" ++ setSGRCode [Reset] ++ " (" ++ help external ++ ")"
......@@ -18,8 +18,6 @@ module Project
) where
import Common
import Control.Exception
import Control.Monad
import Data.Maybe
import Extra
import Network.URI
......@@ -28,6 +26,7 @@ import System.FilePath
import System.Posix.Files
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Resources
data Provisioning
= Copy -- Copy to public and relative URL
......@@ -118,7 +117,7 @@ projectDirectories = do
let publicDir = projectDir </> "public"
let cacheDir = publicDir </> "cache"
let supportDir = publicDir </> ("support" ++ "-" ++ deckerVersion)
appDataDir <- D.getXdgDirectory D.XdgData ("decker" ++ "-" ++ deckerVersion)
appDataDir <- deckerResourceDir
let logDir = projectDir </> "log"
return
(ProjectDirs projectDir publicDir cacheDir supportDir appDataDir logDir)
......
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