External.hs 4.55 KB
Newer Older
1 2 3 4 5 6 7 8 9 10
{-- Author: Henrik Tramberend <henrik@tramberend.de> --}
module External
  ( ssh
  , rsync
  , External.unzip
  , dot
  , gnuplot
  , pdflatex
  , pdf2svg
  , decktape
11
  , sassc
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
  , 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-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)"))
95 96 97 98 99 100 101 102
  , ( "sassc"
    , ExternalProgram
        []
        "sassc"
        ["--style", "nested"]
        ["-v"]
        (helpText
           "Decktape PDF exporter (https://github.com/astefanutti/decktape)"))
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
  ]

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"

131 132 133
sassc :: Program
sassc = makeProgram "sassc"

134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189
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 ++ ")"