{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

----------------------------------------------------------------------------
-- |
-- Module      :  System.Texrunner.Online
-- Copyright   :  (c) 2015 Christopher Chalmers
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  c.chalmers@me.com
--
-- Functions for running and parsing using Tex's online interface. This is
-- mostly used for getting measurements like hbox dimensions and textwidth.
--
-- Tex's online interface is basically running the command line. You can
-- see it by running @pdflatex@ without any arguments. The contents can
-- be written line by and tex can give feedback though stdout, which gets
-- parsed in by this module. This is the only way I know to get info
-- like hbox sizes. Please let me know if you know a better way.
--
-----------------------------------------------------------------------------

module System.Texrunner.Online
  ( OnlineTex
  -- * Running Tex online
  , runOnlineTex

  , runOnlineTex'
  -- * Interaction
  , hbox
  , hsize
  , showthe
  , onlineTexParser
  , texPutStrLn

  -- * Low level
  -- | These functions allow give you direct access to the iostreams
  --   with tex. The implementation is likely to change in the future
  --   and using them directly is not recommended.
  , TexStreams
  , getInStream
  , getOutStream
  , clearUnblocking
  ) where

import           Control.Applicative
import           Control.Monad                (void)
import           Control.Monad.Reader
import qualified Data.Attoparsec.ByteString   as A
import           Data.ByteString.Char8        (ByteString)
import qualified Data.ByteString.Char8        as C8
import qualified Data.ByteString.Lazy.Char8   as LC8
import           Data.List                    (find)
import           Data.Maybe
import           Data.Monoid
import qualified Data.Traversable             as T

import           System.Directory
import           System.FilePath
import           System.IO
import           System.IO.Streams            as Streams
import           System.IO.Streams.Attoparsec
import           System.IO.Temp
import           System.Process               as P (runInteractiveProcess)

import           System.Texrunner.Parse

-- | Type for dealing with Tex's piping interface; the current streams
--   are available though the 'MonadReader' instance.
newtype OnlineTex a = OnlineTex {forall a.
OnlineTex a
-> ReaderT (OutputStream ByteString, InputStream ByteString) IO a
runOnlineTexT :: ReaderT TexStreams IO a}
  deriving (forall a b. a -> OnlineTex b -> OnlineTex a
forall a b. (a -> b) -> OnlineTex a -> OnlineTex b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> OnlineTex b -> OnlineTex a
$c<$ :: forall a b. a -> OnlineTex b -> OnlineTex a
fmap :: forall a b. (a -> b) -> OnlineTex a -> OnlineTex b
$cfmap :: forall a b. (a -> b) -> OnlineTex a -> OnlineTex b
Functor, Functor OnlineTex
forall a. a -> OnlineTex a
forall a b. OnlineTex a -> OnlineTex b -> OnlineTex a
forall a b. OnlineTex a -> OnlineTex b -> OnlineTex b
forall a b. OnlineTex (a -> b) -> OnlineTex a -> OnlineTex b
forall a b c.
(a -> b -> c) -> OnlineTex a -> OnlineTex b -> OnlineTex c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. OnlineTex a -> OnlineTex b -> OnlineTex a
$c<* :: forall a b. OnlineTex a -> OnlineTex b -> OnlineTex a
*> :: forall a b. OnlineTex a -> OnlineTex b -> OnlineTex b
$c*> :: forall a b. OnlineTex a -> OnlineTex b -> OnlineTex b
liftA2 :: forall a b c.
(a -> b -> c) -> OnlineTex a -> OnlineTex b -> OnlineTex c
$cliftA2 :: forall a b c.
(a -> b -> c) -> OnlineTex a -> OnlineTex b -> OnlineTex c
<*> :: forall a b. OnlineTex (a -> b) -> OnlineTex a -> OnlineTex b
$c<*> :: forall a b. OnlineTex (a -> b) -> OnlineTex a -> OnlineTex b
pure :: forall a. a -> OnlineTex a
$cpure :: forall a. a -> OnlineTex a
Applicative, Applicative OnlineTex
forall a. a -> OnlineTex a
forall a b. OnlineTex a -> OnlineTex b -> OnlineTex b
forall a b. OnlineTex a -> (a -> OnlineTex b) -> OnlineTex b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> OnlineTex a
$creturn :: forall a. a -> OnlineTex a
>> :: forall a b. OnlineTex a -> OnlineTex b -> OnlineTex b
$c>> :: forall a b. OnlineTex a -> OnlineTex b -> OnlineTex b
>>= :: forall a b. OnlineTex a -> (a -> OnlineTex b) -> OnlineTex b
$c>>= :: forall a b. OnlineTex a -> (a -> OnlineTex b) -> OnlineTex b
Monad, Monad OnlineTex
forall a. IO a -> OnlineTex a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> OnlineTex a
$cliftIO :: forall a. IO a -> OnlineTex a
MonadIO, MonadReader TexStreams)

-- | Run a tex process, discarding the resulting PDF.
runOnlineTex :: String      -- ^ tex command
             -> [String]    -- ^ tex command arguments
             -> ByteString  -- ^ preamble
             -> OnlineTex a -- ^ Online Tex to be Run
             -> IO a
runOnlineTex :: forall a. String -> [String] -> ByteString -> OnlineTex a -> IO a
runOnlineTex String
command [String]
args ByteString
preamble OnlineTex a
process =
  (\(a
a,TexLog
_,Maybe ByteString
_) -> a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> [String]
-> ByteString
-> OnlineTex a
-> IO (a, TexLog, Maybe ByteString)
runOnlineTex' String
command [String]
args ByteString
preamble OnlineTex a
process

-- | Run a tex process, keeping the resulting PDF. The OnlineTex must receive
--   the terminating control sequence (\\bye, \\end{document}, \\stoptext).
runOnlineTex' :: String
              -> [String]
              -> ByteString
              -> OnlineTex a
              -> IO (a, TexLog, Maybe LC8.ByteString)
runOnlineTex' :: forall a.
String
-> [String]
-> ByteString
-> OnlineTex a
-> IO (a, TexLog, Maybe ByteString)
runOnlineTex' String
command [String]
args ByteString
preamble OnlineTex a
process =
  forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"onlinetex." forall a b. (a -> b) -> a -> b
$ \String
path -> do
    (OutputStream ByteString
outS, InputStream ByteString
inS, ProcessHandle
h) <- String
-> Maybe [(String, String)]
-> String
-> [String]
-> ByteString
-> IO
     (OutputStream ByteString, InputStream ByteString, ProcessHandle)
mkTexHandles String
path forall a. Maybe a
Nothing String
command [String]
args ByteString
preamble
    a
a              <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (OutputStream ByteString
outS, InputStream ByteString
inS) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
OnlineTex a
-> ReaderT (OutputStream ByteString, InputStream ByteString) IO a
runOnlineTexT forall a b. (a -> b) -> a -> b
$ OnlineTex a
process

    forall a. Maybe a -> OutputStream a -> IO ()
write forall a. Maybe a
Nothing OutputStream ByteString
outS
    ExitCode
_ <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
h

    -- it's normally texput.pdf but some (Context) choose random names
    Maybe String
pdfPath  <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==String
".pdf") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtension) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
getDirectoryContents String
path
    Maybe ByteString
pdfFile  <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (String -> IO ByteString
LC8.readFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
path String -> String -> String
</>)) Maybe String
pdfPath

    Maybe String
logPath  <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==String
".log") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtension) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
getDirectoryContents String
path
    Maybe ByteString
logFile  <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (String -> IO ByteString
C8.readFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
path String -> String -> String
</>)) Maybe String
logPath

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

-- | Get the dimensions of a hbox.
hbox :: Fractional n => ByteString -> OnlineTex (Box n)
hbox :: forall n. Fractional n => ByteString -> OnlineTex (Box n)
hbox ByteString
str = do
  OnlineTex ()
clearUnblocking
  ByteString -> OnlineTex ()
texPutStrLn forall a b. (a -> b) -> a -> b
$ ByteString
"\\setbox0=\\hbox{" forall a. Semigroup a => a -> a -> a
<> ByteString
str forall a. Semigroup a => a -> a -> a
<> ByteString
"}\n\\showbox0\n"
  forall a. Parser a -> OnlineTex a
onlineTexParser forall n. Fractional n => Parser (Box n)
parseBox

-- | Parse result from @\showthe@.
showthe :: Fractional n => ByteString -> OnlineTex n
showthe :: forall n. Fractional n => ByteString -> OnlineTex n
showthe ByteString
str = do
  OnlineTex ()
clearUnblocking
  ByteString -> OnlineTex ()
texPutStrLn forall a b. (a -> b) -> a -> b
$ ByteString
"\\showthe" forall a. Semigroup a => a -> a -> a
<> ByteString
str
  forall a. Parser a -> OnlineTex a
onlineTexParser forall n. Fractional n => Parser n
parseUnit

-- | Dimensions from filling the current line.
hsize :: Fractional n => OnlineTex n
hsize :: forall n. Fractional n => OnlineTex n
hsize = forall n. Box n -> n
boxWidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. Fractional n => ByteString -> OnlineTex (Box n)
hbox ByteString
"\\line{\\hfill}"

-- | Run an Attoparsec parser on Tex's output.
onlineTexParser :: A.Parser a -> OnlineTex a
onlineTexParser :: forall a. Parser a -> OnlineTex a
onlineTexParser Parser a
p = OnlineTex (InputStream ByteString)
getInStream forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Parser r -> InputStream ByteString -> IO r
parseFromStream Parser a
p
  -- TODO: have a timeout

texPutStrLn :: ByteString -> OnlineTex ()
texPutStrLn :: ByteString -> OnlineTex ()
texPutStrLn ByteString
a = OnlineTex (OutputStream ByteString)
getOutStream forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> OutputStream a -> IO ()
write (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
C8.append ByteString
a ByteString
"\n")

-- * Internal
-- These functions should be used with caution.

type TexStreams = (OutputStream ByteString, InputStream ByteString)

-- | Get the output stream to read tex's output.
getOutStream :: OnlineTex (OutputStream ByteString)
getOutStream :: OnlineTex (OutputStream ByteString)
getOutStream = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader forall a b. (a, b) -> a
fst

-- | Get the input stream to give text to tex.
getInStream :: OnlineTex (InputStream ByteString)
getInStream :: OnlineTex (InputStream ByteString)
getInStream = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader forall a b. (a, b) -> b
snd

-- | Clear any output tex has already given.
clearUnblocking :: OnlineTex ()
clearUnblocking :: OnlineTex ()
clearUnblocking = OnlineTex (InputStream ByteString)
getInStream forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. InputStream a -> IO (Maybe a)
Streams.read

-- | Uses a surface to open an interface with Tex.
mkTexHandles :: FilePath
             -> Maybe [(String, String)]
             -> String
             -> [String]
             -> ByteString
             -> IO (OutputStream ByteString,
                    InputStream ByteString,
                    ProcessHandle)
mkTexHandles :: String
-> Maybe [(String, String)]
-> String
-> [String]
-> ByteString
-> IO
     (OutputStream ByteString, InputStream ByteString, ProcessHandle)
mkTexHandles String
dir Maybe [(String, String)]
env String
command [String]
args ByteString
preamble = do

  -- Tex doesn't send anything to stderr
  (OutputStream ByteString
outStream, InputStream ByteString
inStream, InputStream ByteString
_, ProcessHandle
h) <- String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO
     (OutputStream ByteString, InputStream ByteString,
      InputStream ByteString, ProcessHandle)
runInteractiveProcess'
                                   String
command
                                   [String]
args
                                   (forall a. a -> Maybe a
Just String
dir)
                                   Maybe [(String, String)]
env

  -- inStream <- debugStream inStream'

  -- commands to get Tex to play nice
  forall a. Maybe a -> OutputStream a -> IO ()
write (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString
"\\tracingonline=1"  -- \showbox is echoed to stdout
             forall a. Semigroup a => a -> a -> a
<> ByteString
"\\showboxdepth=1"   -- show boxes one deep
             forall a. Semigroup a => a -> a -> a
<> ByteString
"\\showboxbreadth=1"
             forall a. Semigroup a => a -> a -> a
<> ByteString
"\\scrollmode\n"     -- don't pause after showing something
        ) OutputStream ByteString
outStream
  forall a. Maybe a -> OutputStream a -> IO ()
write (forall a. a -> Maybe a
Just ByteString
preamble) OutputStream ByteString
outStream

  forall (m :: * -> *) a. Monad m => a -> m a
return (OutputStream ByteString
outStream, InputStream ByteString
inStream, ProcessHandle
h)

-- Adapted from io-streams. Sets input handle to line buffering.
runInteractiveProcess'
    :: FilePath                 -- ^ Filename of the executable (see 'proc' for details)
    -> [String]                 -- ^ Arguments to pass to the executable
    -> Maybe FilePath           -- ^ Optional path to the working directory
    -> Maybe [(String,String)]  -- ^ Optional environment (otherwise inherit)
    -> IO (OutputStream ByteString,
           InputStream ByteString,
           InputStream ByteString,
           ProcessHandle)
runInteractiveProcess' :: String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO
     (OutputStream ByteString, InputStream ByteString,
      InputStream ByteString, ProcessHandle)
runInteractiveProcess' String
cmd [String]
args Maybe String
wd Maybe [(String, String)]
env = do
    (Handle
hin, Handle
hout, Handle
herr, ProcessHandle
ph) <- String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO (Handle, Handle, Handle, ProcessHandle)
P.runInteractiveProcess String
cmd [String]
args Maybe String
wd Maybe [(String, String)]
env

    -- it is possible to flush using write (Just "") but this seems nicer
    -- is there a better way?
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
hin BufferMode
LineBuffering

    OutputStream ByteString
sIn  <- Handle -> IO (OutputStream ByteString)
Streams.handleToOutputStream Handle
hin forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            forall b a. IO b -> OutputStream a -> IO (OutputStream a)
Streams.atEndOfOutput (Handle -> IO ()
hClose Handle
hin) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            forall a. OutputStream a -> IO (OutputStream a)
Streams.lockingOutputStream
    InputStream ByteString
sOut <- Handle -> IO (InputStream ByteString)
Streams.handleToInputStream Handle
hout forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            forall b a. IO b -> InputStream a -> IO (InputStream a)
Streams.atEndOfInput (Handle -> IO ()
hClose Handle
hout) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            forall a. InputStream a -> IO (InputStream a)
Streams.lockingInputStream
    InputStream ByteString
sErr <- Handle -> IO (InputStream ByteString)
Streams.handleToInputStream Handle
herr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            forall b a. IO b -> InputStream a -> IO (InputStream a)
Streams.atEndOfInput (Handle -> IO ()
hClose Handle
herr) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            forall a. InputStream a -> IO (InputStream a)
Streams.lockingInputStream

    forall (m :: * -> *) a. Monad m => a -> m a
return (OutputStream ByteString
sIn, InputStream ByteString
sOut, InputStream ByteString
sErr, ProcessHandle
ph)

-- debugStream :: InputStream ByteString -> IO (InputStream ByteString)
-- debugStream = debugInput id "tex" Streams.stdout