----------------------------------------------------------------------------
-- |
-- Module      :  System.Texrunner
-- Copyright   :  (c) 2014 Christopher Chalmers
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  c.chalmers@me.com
--
-- Functions for running Tex.
--
-----------------------------------------------------------------------------

module System.Texrunner
  ( runTex
  , runTex'
  , prettyPrintLog
  ) where

import           Control.Applicative
import qualified Data.ByteString.Char8      as C8 hiding (concatMap)
import           Data.ByteString.Lazy.Char8 as LC8 hiding (concatMap)
import           Data.Maybe

import           System.Directory
import           System.Environment
import           System.Exit
import           System.FilePath
import           System.IO
import           System.IO.Temp
import           System.Process

import           System.Texrunner.Parse

-- | Same as 'runTex'' but runs Tex in a temporary system directory.
runTex :: String     -- ^ Tex command
       -> [String]   -- ^ Additional arguments
       -> [FilePath] -- ^ Additional Tex input paths
       -> ByteString -- ^ Source Tex file
       -> IO (ExitCode, TexLog, Maybe ByteString)
runTex :: String
-> [String]
-> [String]
-> ByteString
-> IO (ExitCode, TexLog, Maybe ByteString)
runTex String
command [String]
args [String]
extras ByteString
source =
  forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"texrunner." forall a b. (a -> b) -> a -> b
$ \String
path ->
    String
-> String
-> [String]
-> [String]
-> ByteString
-> IO (ExitCode, TexLog, Maybe ByteString)
runTex' String
path String
command [String]
args [String]
extras ByteString
source

-- | Run Tex program in the given directory. Additional Tex inputs are
--   for filepaths to things like images that Tex can refer to.
runTex' :: FilePath   -- ^ Directory to run Tex in
        -> String     -- ^ Tex command
        -> [String]   -- ^ Additional arguments
        -> [FilePath] -- ^ Additional Tex inputs
        -> ByteString -- ^ Source Tex file
        -> IO (ExitCode, TexLog, Maybe ByteString)
runTex' :: String
-> String
-> [String]
-> [String]
-> ByteString
-> IO (ExitCode, TexLog, Maybe ByteString)
runTex' String
path String
command [String]
args [String]
extras ByteString
source = do

  String -> ByteString -> IO ()
LC8.writeFile (String
path String -> String -> String
</> String
"texrunner.tex") ByteString
source

  [(String, String)]
environment <- [String] -> [(String, String)] -> [(String, String)]
extraTexInputs (String
pathforall a. a -> [a] -> [a]
:[String]
extras) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment

  let p :: CreateProcess
p = (String -> [String] -> CreateProcess
proc String
command (String
"texrunner.tex" forall a. a -> [a] -> [a]
: [String]
args))
            { cwd :: Maybe String
cwd     = forall a. a -> Maybe a
Just String
path
            , std_in :: StdStream
std_in  = StdStream
CreatePipe
            , std_out :: StdStream
std_out = StdStream
CreatePipe
            , env :: Maybe [(String, String)]
env     = forall a. a -> Maybe a
Just [(String, String)]
environment
            }

  (Just Handle
inH, Just Handle
outH, Maybe Handle
_, ProcessHandle
pHandle) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
p

  Handle -> IO ()
hClose Handle
inH
  ByteString
a <- Handle -> IO ByteString
C8.hGetContents Handle
outH -- backup log

  Handle -> IO ()
hClose Handle
outH
  ExitCode
exitC <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pHandle

  Bool
pdfExists <- String -> IO Bool
doesFileExist (String
path String -> String -> String
</> String
"texrunner.pdf")
  Maybe ByteString
pdfFile   <- if Bool
pdfExists
                  then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
LC8.readFile (String
path String -> String -> String
</> String
"texrunner.pdf")
                  else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

  Bool
logExists <- String -> IO Bool
doesFileExist (String
path String -> String -> String
</> String
"texrunner.log")
  Maybe ByteString
logFile   <- if Bool
logExists
                  then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
C8.readFile (String
path String -> String -> String
</> String
"texrunner.log")
                  else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

  -- pdfFile <- optional $ LC8.readFile (path </> "texrunner.pdf")
  -- logFile <- optional $ C8.readFile (path </> "texrunner.log")

  forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
exitC, ByteString -> TexLog
parseLog forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe ByteString
a Maybe ByteString
logFile, Maybe ByteString
pdfFile)

-- | Add a list of paths to the tex
extraTexInputs :: [FilePath] -> [(String,String)] -> [(String,String)]
extraTexInputs :: [String] -> [(String, String)] -> [(String, String)]
extraTexInputs []      = forall a. a -> a
id
extraTexInputs [String]
inputss = forall k a.
Eq k =>
(Maybe a -> Maybe a) -> k -> [(k, a)] -> [(k, a)]
alter Maybe String -> Maybe String
f String
"TEXINPUTS"
  where
    f :: Maybe String -> Maybe String
f Maybe String
Nothing  = forall a. a -> Maybe a
Just String
inputs
    f (Just String
x) = forall a. a -> Maybe a
Just (String
inputs forall a. [a] -> [a] -> [a]
++ [Char
searchPathSeparator] forall a. [a] -> [a] -> [a]
++ String
x)
    --
    inputs :: String
inputs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. [a] -> [a] -> [a]
++ [Char
searchPathSeparator]) [String]
inputss
    -- inputs = intercalate [searchPathSeparator] inputss

-- Alter can be used to insert, delete or update an element. Similar to alter
-- in Data.Map.
alter :: Eq k => (Maybe a -> Maybe a) -> k -> [(k,a)] -> [(k,a)]
alter :: forall k a.
Eq k =>
(Maybe a -> Maybe a) -> k -> [(k, a)] -> [(k, a)]
alter Maybe a -> Maybe a
f k
k = [(k, a)] -> [(k, a)]
go
  where
    go :: [(k, a)] -> [(k, a)]
go []         = forall a. Maybe a -> [a]
maybeToList ((,) k
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> Maybe a
f forall a. Maybe a
Nothing)
    go ((k
k',a
x):[(k, a)]
xs)
      | k
k' forall a. Eq a => a -> a -> Bool
== k
k   = case Maybe a -> Maybe a
f (forall a. a -> Maybe a
Just a
x) of
                      Just a
x' -> (k
k',a
x') forall a. a -> [a] -> [a]
: [(k, a)]
xs
                      Maybe a
Nothing -> [(k, a)]
xs
      | Bool
otherwise = (k
k',a
x) forall a. a -> [a] -> [a]
: [(k, a)] -> [(k, a)]
go [(k, a)]
xs