From 1a520f0c561c906fe6dfe34aad0f9824abd68ca9 Mon Sep 17 00:00:00 2001 From: David Date: Sat, 16 Feb 2019 11:41:25 +0100 Subject: [PATCH] Move shared tools to a separate module. --- reanimate.cabal | 2 ++ src/Reanimate/LaTeX.hs | 47 ++++--------------------------------- src/Reanimate/Misc.hs | 52 +++++++++++++++++++++++++++++++++++++++++ src/Reanimate/Render.hs | 41 ++------------------------------ 4 files changed, 61 insertions(+), 81 deletions(-) create mode 100644 src/Reanimate/Misc.hs diff --git a/reanimate.cabal b/reanimate.cabal index 902b0bb..40daa6a 100644 --- a/reanimate.cabal +++ b/reanimate.cabal @@ -21,6 +21,7 @@ library Reanimate.Examples Reanimate.Combinators Reanimate.LaTeX + other-modules: Reanimate.Misc build-depends: base >=4.12 && <4.13, lucid-svg, time, text, unix, lucid, filepath, process, directory, containers, svg-tree, xml, bytestring @@ -33,6 +34,7 @@ executable reanimate-viewer Reanimate.Examples Reanimate.Combinators Reanimate.LaTeX + Reanimate.Misc build-depends: base >=4.12 && <4.13, cairo >=0.13 && <0.14, gtk, svgcairo, lucid-svg, time, text, unix, lucid, reanimate, filepath, process, directory, containers, svg-tree, xml, diff --git a/src/Reanimate/LaTeX.hs b/src/Reanimate/LaTeX.hs index d43b781..e458ff4 100644 --- a/src/Reanimate/LaTeX.hs +++ b/src/Reanimate/LaTeX.hs @@ -2,19 +2,16 @@ {-# LANGUAGE ScopedTypeVariables #-} module Reanimate.LaTeX (latex) where -import Control.Exception +import Control.Exception (SomeException, handle) import qualified Data.ByteString as B import Data.IORef import Data.Map (Map) import qualified Data.Map as Map -import Lucid (ToHtml(..)) +import Lucid (ToHtml (..)) import Lucid.Svg (Svg, fill_, font_size_, text_) -import System.Directory -import System.Exit -import System.FilePath -import System.IO -import System.IO.Unsafe -import System.Process +import Reanimate.Misc +import System.FilePath (replaceExtension, takeFileName, ()) +import System.IO.Unsafe (unsafePerformIO) import Graphics.Svg (loadSvgFile, parseSvgFile, xmlOfDocument) @@ -59,40 +56,6 @@ failedSvg tex = text_ [ font_size_ "20" , fill_ "white"] (toHtml $ "bad latex: "++tex) -runCmd exec args = do - (ret, stdout, stderr) <- readProcessWithExitCode exec args "" - evaluate (length stdout + length stderr) - case ret of - ExitSuccess -> return () - ExitFailure err -> do - putStrLn $ - "Failed to run: " ++ showCommandForUser exec args ++ "\n" ++ - "Error code: " ++ show err ++ "\n" ++ - "stderr: " ++ show stderr - throwIO (ExitFailure err) - -withTempDir action = do - dir <- getTemporaryDirectory - (path, handle) <- openTempFile dir "reanimate-XXXXXX" - hClose handle - removeFile path - createDirectory (dir path) - action (dir path) `finally` removeDirectoryRecursive (dir path) - -withTempFile ext action = do - dir <- getTemporaryDirectory - (path, handle) <- openTempFile dir ("reanimate-XXXXXX" <.> ext) - hClose handle - action path `finally` removeFile path - -requireExecutable :: String -> IO FilePath -requireExecutable exec = do - mbPath <- findExecutable exec - case mbPath of - Nothing -> error $ "Couldn't find executable: " ++ exec - Just path -> return path - - tex_prologue = "\\documentclass[preview]{standalone}\n\ \\\usepackage[english]{babel}\n\ diff --git a/src/Reanimate/Misc.hs b/src/Reanimate/Misc.hs new file mode 100644 index 0000000..47228fc --- /dev/null +++ b/src/Reanimate/Misc.hs @@ -0,0 +1,52 @@ +module Reanimate.Misc + ( requireExecutable + , runCmd + , withTempDir + , withTempFile + ) where + +import Control.Exception (evaluate, finally, throwIO) +import System.Directory (createDirectory, findExecutable, + getTemporaryDirectory, + removeDirectoryRecursive, removeFile) +import System.Exit (ExitCode (..)) +import System.FilePath ((<.>), ()) +import System.IO (hClose, openTempFile) +import System.Process (readProcessWithExitCode, showCommandForUser) + + +requireExecutable :: String -> IO FilePath +requireExecutable exec = do + mbPath <- findExecutable exec + case mbPath of + Nothing -> error $ "Couldn't find executable: " ++ exec + Just path -> return path + +runCmd :: FilePath -> [String] -> IO () +runCmd exec args = do + (ret, stdout, stderr) <- readProcessWithExitCode exec args "" + evaluate (length stdout + length stderr) + case ret of + ExitSuccess -> return () + ExitFailure err -> do + putStrLn $ + "Failed to run: " ++ showCommandForUser exec args ++ "\n" ++ + "Error code: " ++ show err ++ "\n" ++ + "stderr: " ++ show stderr + throwIO (ExitFailure err) + +withTempDir :: (FilePath -> IO a) -> IO a +withTempDir action = do + dir <- getTemporaryDirectory + (path, handle) <- openTempFile dir "reanimate-XXXXXX" + hClose handle + removeFile path + createDirectory (dir path) + action (dir path) `finally` removeDirectoryRecursive (dir path) + +withTempFile :: String -> (FilePath -> IO a) -> IO a +withTempFile ext action = do + dir <- getTemporaryDirectory + (path, handle) <- openTempFile dir ("reanimate-XXXXXX" <.> ext) + hClose handle + action path `finally` removeFile path diff --git a/src/Reanimate/Render.hs b/src/Reanimate/Render.hs index 569f050..86c0698 100644 --- a/src/Reanimate/Render.hs +++ b/src/Reanimate/Render.hs @@ -2,16 +2,12 @@ module Reanimate.Render ( render ) where -import Control.Exception (evaluate, finally, throwIO) import Control.Monad (forM_) import Lucid.Svg (renderToFile) import Reanimate.Arrow (Ani, animationDuration, frameAt) import Reanimate.Examples -import System.Directory -import System.Exit -import System.FilePath -import System.IO -import System.Process +import Reanimate.Misc +import System.FilePath (takeExtension, ()) import Text.Printf (printf) @@ -74,36 +70,3 @@ generateFrames ani rate action = withTempDir $ \tmp -> do frameCount = round (animationDuration ani * fromIntegral rate) :: Int nameTemplate :: String nameTemplate = "render-%05d.svg" - -requireExecutable :: String -> IO FilePath -requireExecutable exec = do - mbPath <- findExecutable exec - case mbPath of - Nothing -> error $ "Couldn't find executable: " ++ exec - Just path -> return path - -runCmd exec args = do - (ret, stdout, stderr) <- readProcessWithExitCode exec args "" - evaluate (length stdout + length stderr) - case ret of - ExitSuccess -> return () - ExitFailure err -> do - putStrLn $ - "Failed to run: " ++ showCommandForUser exec args ++ "\n" ++ - "Error code: " ++ show err ++ "\n" ++ - "stderr: " ++ show stderr - throwIO (ExitFailure err) - -withTempDir action = do - dir <- getTemporaryDirectory - (path, handle) <- openTempFile dir "reanimate-XXXXXX" - hClose handle - removeFile path - createDirectory (dir path) - action (dir path) `finally` removeDirectoryRecursive (dir path) - -withTempFile ext action = do - dir <- getTemporaryDirectory - (path, handle) <- openTempFile dir ("reanimate-XXXXXX" <.> ext) - hClose handle - action path `finally` removeFile path