lhslatex-0.1.0.0: lhslatex.hs

import System.Directory
import System.Environment
import Text.Regex.Posix
import System.FilePath.Posix
import Data.List
import System.Process
import Control.Monad

createTmpDir :: FilePath -> IO FilePath
createTmpDir base = do
  let dir = addExtension base ".XXXXXXXXXX"
  exists <- doesDirectoryExist dir
  when exists $ removeDirectoryRecursive dir
  createDirectory dir
  return dir

splitArgs :: [String] -> (String,[String])
splitArgs args =
  let (file, args') = partition (=~ "\\.lhs$") args
      file' = case file of
                [f] -> f
                _   -> error "could not identify .lhs file"
      (stem,_) = splitExtension file'
  in (stem, args')

moveFile :: FilePath -> FilePath -> IO ()
moveFile fp1 fp2 = do
--  error $ show (fp1,fp2)
  exists <- doesFileExist fp2
  when exists (removeFile fp2)
  renameFile fp1 fp2

main :: IO ()
main = do
  args <- getArgs
  let (stem,args') = splitArgs args
      file = addExtension stem ".lhs"
      texFile = addExtension stem ".tex"
      pdfFile = addExtension stem ".pdf"
      auxFile = addExtension stem ".aux"
  old_dir <- getCurrentDirectory
  tmp_dir <- createTmpDir (old_dir </> "lhslatex")
  tInputs' <- lookupEnv "TEXINPUTS"
  let tInputs = case tInputs' of
                  Just e  -> e
                  Nothing -> ""
  setEnv "TEXINPUTS" $ old_dir ++ ":" ++ tInputs
  lhsFile <- readFile file
  setCurrentDirectory tmp_dir
  tex <- readProcess "lhs2TeX" ["-"] lhsFile
  writeFile texFile tex
  callProcess "pdflatex" (args' ++ [texFile])
  moveFile (tmp_dir </> pdfFile) (old_dir </> pdfFile)
  moveFile (tmp_dir </> auxFile) (old_dir </> auxFile)
  removeDirectoryRecursive tmp_dir