{-# LANGUAGE ScopedTypeVariables #-}
module Reanimate.Driver.Check
  ( checkEnvironment
  , hasRSvg
  , hasInkscape
  , hasMagick
  , hasFFmpegRSvg
  ) where

import           Control.Exception            (SomeException, handle)
import           Control.Monad                (forM_)
import           Data.Maybe                   (fromMaybe, listToMaybe)
import           Data.Version                 (Version (Version), parseVersion, showVersion)
import           Reanimate.Driver.Magick      (magickCmd)
import           Reanimate.Misc               (runCmd_)
import           System.Console.ANSI.Codes
import           System.Directory             (findExecutable)
import           System.IO                    (hClose, hPutStr)
import           System.IO.Temp               (withSystemTempDirectory, withTempFile)
import           Text.ParserCombinators.ReadP (readP_to_S)
import           Text.Printf                  (printf)

--------------------------------------------------------------------------
-- Check environment

checkEnvironment :: IO ()
checkEnvironment :: IO ()
checkEnvironment = do
    String -> IO ()
putStrLn String
"reanimate checks:"
    String -> IO (Either String String) -> IO ()
runCheck String
"Has ffmpeg" IO (Either String String)
hasFFmpeg
    String -> IO (Either String String) -> IO ()
runCheck String
"Has ffmpeg(rsvg)" IO (Either String String)
hasFFmpegRSvg
    String -> IO (Either String String) -> IO ()
runCheck String
"Has dvisvgm" IO (Either String String)
hasDvisvgm
    String -> IO (Either String String) -> IO ()
runCheck String
"Has povray" IO (Either String String)
hasPovray
    String -> IO (Either String String) -> IO ()
runCheck String
"Has blender" IO (Either String String)
hasBlender
    String -> IO (Either String String) -> IO ()
runCheck String
"Has rsvg-convert" IO (Either String String)
hasRSvg
    String -> IO (Either String String) -> IO ()
runCheck String
"Has inkscape" IO (Either String String)
hasInkscape
    String -> IO (Either String String) -> IO ()
runCheck String
"Has imagemagick" IO (Either String String)
hasMagick
    String -> IO (Either String String) -> IO ()
runCheck String
"Has LaTeX" IO (Either String String)
hasLaTeX
    String -> IO (Either String String) -> IO ()
runCheck (String
"Has LaTeX package '"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"babel" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") (IO (Either String String) -> IO ())
-> IO (Either String String) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO (Either String String)
hasTeXPackage String
"latex"
      String
"[english]{babel}"
    [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
latexPackages ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
pkg ->
      String -> IO (Either String String) -> IO ()
runCheck (String
"Has LaTeX package '"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") (IO (Either String String) -> IO ())
-> IO (Either String String) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO (Either String String)
hasTeXPackage String
"latex" (String -> IO (Either String String))
-> String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$
        String
"{"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
pkgString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}"
    String -> IO (Either String String) -> IO ()
runCheck String
"Has XeLaTeX" IO (Either String String)
hasXeLaTeX
    [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
xelatexPackages ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
pkg ->
      String -> IO (Either String String) -> IO ()
runCheck (String
"Has XeLaTeX package '"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") (IO (Either String String) -> IO ())
-> IO (Either String String) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO (Either String String)
hasTeXPackage String
"xelatex" (String -> IO (Either String String))
-> String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$
        String
"{"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
pkgString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}"
  where
    latexPackages :: [String]
latexPackages =
      [String
"preview"
      ,String
"amsmath"
      --,"amssymb"
      --,"dsfont"
      --,"setspace"
      --,"relsize"
      --,"textcomp"
      --,"mathrsfs"
      --,"calligra"
      --,"wasysym"
      --,"ragged2e"
      --,"physics"
      --,"xcolor"
      --,"textcomp"
      --,"xfrac"
      --,"microtype"
      ]
    xelatexPackages :: [String]
xelatexPackages =
      [String
"ctex"]
    runCheck :: String -> IO (Either String String) -> IO ()
runCheck String
msg IO (Either String String)
fn = do
      String -> String -> IO ()
forall r. PrintfType r => String -> r
printf String
"  %-35s" (String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":")
      Either String String
val <- IO (Either String String)
fn
      case Either String String
val of
        Left String
err -> Color -> String -> IO ()
putStrLnColor Color
Red String
err
        Right String
ok -> Color -> String -> IO ()
putStrLnColor Color
Green String
ok

putStrLnColor :: Color -> String -> IO ()
putStrLnColor :: Color -> String -> IO ()
putStrLnColor Color
color String
msg =
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
color] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ [SGR] -> String
setSGRCode [SGR
Reset]

-- latex, dvisvgm, xelatex

hasLaTeX :: IO (Either String String)
hasLaTeX :: IO (Either String String)
hasLaTeX = String -> IO (Either String String)
hasProgram String
"latex"

hasXeLaTeX :: IO (Either String String)
hasXeLaTeX :: IO (Either String String)
hasXeLaTeX = String -> IO (Either String String)
hasProgram String
"xelatex"

hasDvisvgm :: IO (Either String String)
hasDvisvgm :: IO (Either String String)
hasDvisvgm = String -> IO (Either String String)
hasProgram String
"dvisvgm"

hasPovray :: IO (Either String String)
hasPovray :: IO (Either String String)
hasPovray = String -> IO (Either String String)
hasProgram String
"povray"

hasFFmpeg :: IO (Either String String)
hasFFmpeg :: IO (Either String String)
hasFFmpeg = Version -> Maybe Version -> Either String String
checkMinVersion Version
minVersion (Maybe Version -> Either String String)
-> IO (Maybe Version) -> IO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe Version)
ffmpegVersion
  where
    minVersion :: Version
minVersion = [Int] -> [String] -> Version
Version [Int
4,Int
1,Int
3] []

hasFFmpegRSvg :: IO (Either String String)
hasFFmpegRSvg :: IO (Either String String)
hasFFmpegRSvg = do
  Maybe String
mbPath <- String -> IO (Maybe String)
findExecutable String
"ffmpeg"
  case Maybe String
mbPath of
    Maybe String
Nothing -> Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
"n/a"
    Just String
path -> do
      Either String String
ret <- String -> [String] -> IO (Either String String)
runCmd_ String
path [String
"-version"]
      Either String String -> IO (Either String String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ case Either String String
ret of
        Right String
out | String
"--enable-librsvg" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String -> [String]
words String
out
          -> String -> Either String String
forall a b. b -> Either a b
Right String
"yes"
        Either String String
_ -> String -> Either String String
forall a b. a -> Either a b
Left String
"no"

hasBlender :: IO (Either String String)
hasBlender :: IO (Either String String)
hasBlender = Version -> Maybe Version -> Either String String
checkMinVersion Version
minVersion (Maybe Version -> Either String String)
-> IO (Maybe Version) -> IO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe Version)
blenderVersion
  where
    minVersion :: Version
minVersion = [Int] -> [String] -> Version
Version [Int
2,Int
80] []

hasRSvg :: IO (Either String String)
hasRSvg :: IO (Either String String)
hasRSvg = Version -> Maybe Version -> Either String String
checkMinVersion Version
minVersion (Maybe Version -> Either String String)
-> IO (Maybe Version) -> IO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe Version)
rsvgVersion
  where
    minVersion :: Version
minVersion = [Int] -> [String] -> Version
Version [Int
2,Int
44,Int
0] []

hasInkscape :: IO (Either String String)
hasInkscape :: IO (Either String String)
hasInkscape = Version -> Maybe Version -> Either String String
checkMinVersion Version
minVersion (Maybe Version -> Either String String)
-> IO (Maybe Version) -> IO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe Version)
inkscapeVersion
  where
    minVersion :: Version
minVersion = [Int] -> [String] -> Version
Version [Int
0,Int
92] []

hasMagick :: IO (Either String String)
hasMagick :: IO (Either String String)
hasMagick = Version -> Maybe Version -> Either String String
checkMinVersion Version
minVersion (Maybe Version -> Either String String)
-> IO (Maybe Version) -> IO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe Version)
magickVersion
  where
    minVersion :: Version
minVersion = [Int] -> [String] -> Version
Version [Int
6,Int
0,Int
0] []

ffmpegVersion :: IO (Maybe Version)
ffmpegVersion :: IO (Maybe Version)
ffmpegVersion = String -> [String] -> (String -> String) -> IO (Maybe Version)
extractVersion String
"ffmpeg" [String
"-version"] ((String -> String) -> IO (Maybe Version))
-> (String -> String) -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ \String
line ->
      case Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
3 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
line of
        [String
"ffmpeg", String
"version", String
vs] -> String
vs
        [String]
_                         -> String
""

blenderVersion :: IO (Maybe Version)
blenderVersion :: IO (Maybe Version)
blenderVersion = String -> [String] -> (String -> String) -> IO (Maybe Version)
extractVersion String
"blender" [String
"--version"] ((String -> String) -> IO (Maybe Version))
-> (String -> String) -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ \String
line ->
    case Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
2 (String -> [String]
words String
line) of
      [String
"Blender", String
vs] -> String
vs
      [String]
_               -> String
""

rsvgVersion :: IO (Maybe Version)
rsvgVersion :: IO (Maybe Version)
rsvgVersion = String -> [String] -> (String -> String) -> IO (Maybe Version)
extractVersion String
"rsvg-convert" [String
"--version"] ((String -> String) -> IO (Maybe Version))
-> (String -> String) -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ \String
line ->
  case String -> [String]
words String
line of
    [String
"rsvg-convert", String
"version", String
vs] -> String
vs
    [String]
_                               -> String
""

inkscapeVersion :: IO (Maybe Version)
inkscapeVersion :: IO (Maybe Version)
inkscapeVersion = String -> [String] -> (String -> String) -> IO (Maybe Version)
extractVersion String
"inkscape" [String
"--version"] ((String -> String) -> IO (Maybe Version))
-> (String -> String) -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ \String
line ->
    case Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
2 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
line of
      [String
"Inkscape", String
vs] -> String
vs
      [String]
_                -> String
""

magickVersion :: IO (Maybe Version)
magickVersion :: IO (Maybe Version)
magickVersion = String -> [String] -> (String -> String) -> IO (Maybe Version)
extractVersion String
magickCmd [String
"-version"] ((String -> String) -> IO (Maybe Version))
-> (String -> String) -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ \String
line ->
    case Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
3 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
line of
      [String
"Version:", String
"ImageMagick", String
vs] -> String
vs
      [String]
_                               -> String
""

checkMinVersion :: Version -> Maybe Version -> Either String String
checkMinVersion :: Version -> Maybe Version -> Either String String
checkMinVersion Version
_minVersion Maybe Version
Nothing = String -> Either String String
forall a b. a -> Either a b
Left String
"no"
checkMinVersion Version
minVersion (Just Version
vs)
  | Version
vs Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
minVersion = String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"too old: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
vs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" < " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
minVersion
  | Bool
otherwise       = String -> Either String String
forall a b. b -> Either a b
Right (Version -> String
showVersion Version
vs)

extractVersion :: FilePath -> [String] -> (String -> String) -> IO (Maybe Version)
extractVersion :: String -> [String] -> (String -> String) -> IO (Maybe Version)
extractVersion String
execPath [String]
args String -> String
outputFilter = do
  Maybe String
mbPath <- String -> IO (Maybe String)
findExecutable String
execPath
  case Maybe String
mbPath of
    Maybe String
Nothing -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Version
forall a. Maybe a
Nothing
    Just String
path -> do
      Either String String
ret <- String -> [String] -> IO (Either String String)
runCmd_ String
path [String]
args
      case Either String String
ret of
        Left{} -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> IO (Maybe Version))
-> Maybe Version -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version
forall a. a -> Maybe a
Just Version
noVersion
        Right String
out ->
          Maybe Version -> IO (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Version -> IO (Maybe Version))
-> Maybe Version -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe Version
noVersion (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ String -> Maybe Version
parseVS (String -> Maybe Version) -> String -> Maybe Version
forall a b. (a -> b) -> a -> b
$ String -> String
outputFilter String
out
  where
    noVersion :: Version
noVersion = [Int] -> [String] -> Version
Version [] []
    parseVS :: String -> Maybe Version
parseVS String
vs = [Version] -> Maybe Version
forall a. [a] -> Maybe a
listToMaybe ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version] -> [Version]
forall a. [a] -> [a]
reverse
      [ Version
v | (Version
v, String
_) <- ReadP Version -> ReadS Version
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion String
vs ]

hasTeXPackage :: FilePath -> String -> IO (Either String String)
hasTeXPackage :: String -> String -> IO (Either String String)
hasTeXPackage String
exec String
pkg = (SomeException -> IO (Either String String))
-> IO (Either String String) -> IO (Either String String)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException
_::SomeException) -> Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
"n/a") (IO (Either String String) -> IO (Either String String))
-> IO (Either String String) -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$
    String
-> (String -> IO (Either String String))
-> IO (Either String String)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"reanimate" ((String -> IO (Either String String))
 -> IO (Either String String))
-> (String -> IO (Either String String))
-> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ \String
tmp_dir -> String
-> String
-> (String -> Handle -> IO (Either String String))
-> IO (Either String String)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> String -> (String -> Handle -> m a) -> m a
withTempFile String
tmp_dir String
"test.tex" ((String -> Handle -> IO (Either String String))
 -> IO (Either String String))
-> (String -> Handle -> IO (Either String String))
-> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ \String
tex_file Handle
tex_handle -> do
      Handle -> String -> IO ()
hPutStr Handle
tex_handle String
tex_document
      Handle -> String -> IO ()
hPutStr Handle
tex_handle (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\\usepackage" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
      Handle -> String -> IO ()
hPutStr Handle
tex_handle String
"\\begin{document}\n"
      Handle -> String -> IO ()
hPutStr Handle
tex_handle String
"blah\n"
      Handle -> String -> IO ()
hPutStr Handle
tex_handle String
tex_epilogue
      Handle -> IO ()
hClose Handle
tex_handle
      Either String String
ret <- String -> [String] -> IO (Either String String)
runCmd_ String
exec [String
"-interaction=batchmode", String
"-halt-on-error", String
"-output-directory="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
tmp_dir, String
tex_file]
      Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ case Either String String
ret of
        Right{} -> String -> Either String String
forall a b. b -> Either a b
Right String
"OK"
        Left{}  -> String -> Either String String
forall a b. a -> Either a b
Left String
"missing"
  where
    tex_document :: String
tex_document = String
"\\documentclass[preview]{standalone}\n"
    tex_epilogue :: String
tex_epilogue =
      String
"\n\
      \\\end{document}"

hasProgram :: String -> IO (Either String String)
hasProgram :: String -> IO (Either String String)
hasProgram String
exec = do
  Maybe String
mbPath <- String -> IO (Maybe String)
findExecutable String
exec
  Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ case Maybe String
mbPath of
    Maybe String
Nothing   -> String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exec String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' not found"
    Just String
path -> String -> Either String String
forall a b. b -> Either a b
Right String
path