module Blagda.Diagrams where

import Blagda.Utils
import Control.Monad.Writer
import Development.Shake
import Development.Shake.FilePath
import Development.Shake.Forward (cacheAction)


buildDiagrams :: Action ()
buildDiagrams :: Action ()
buildDiagrams = do
  [FilePath]
diagrams <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
"_build/diagrams" FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> Action [FilePath] -> Action [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> Action [FilePath]
getDirectoryFiles FilePath
"_build/diagrams" [FilePath
"*.tex"]
  Action [()] -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action [()] -> Action ()) -> Action [()] -> Action ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> (FilePath -> Action ()) -> Action [()]
forall a b. [a] -> (a -> Action b) -> Action [b]
forP [FilePath]
diagrams ((FilePath -> Action ()) -> Action [()])
-> (FilePath -> Action ()) -> Action [()]
forall a b. (a -> b) -> a -> b
$ \FilePath
input -> do
    FilePath -> Action () -> Action ()
forall a b.
(Typeable a, Binary a, Show a, Typeable b, Binary b, Show b) =>
a -> Action b -> Action b
cacheAction FilePath
input (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$
      Partial => [CmdOption] -> FilePath -> [FilePath] -> Action ()
[CmdOption] -> FilePath -> [FilePath] -> Action ()
command_ [FilePath -> CmdOption
Traced FilePath
"build-diagram"] FilePath
"sh" [FilePath
"support/build-diagram.sh", FilePath -> FilePath -> FilePath -> FilePath
getBuildPath FilePath
"html" FilePath
"svg" FilePath
input, FilePath
input]