summaryrefslogtreecommitdiff
path: root/src/System/Texrunner/Online.hs
blob: 1e1dd8603f922eec39b584b17351e346142635c7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
{-# 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 writen 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.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 {runOnlineTexT :: ReaderT TexStreams IO a}
  deriving (Functor, Applicative, Monad, 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 command args preamble process =
  (\(a,_,_) -> a) <$> runOnlineTex' command args preamble 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' command args preamble process =
  withSystemTempDirectory "onlinetex." $ \path -> do
    (outS, inS, h) <- mkTexHandles path Nothing command args preamble
    a              <- flip runReaderT (outS, inS) . runOnlineTexT $ process

    write Nothing outS
    _ <- waitForProcess h

    -- it's normally texput.pdf but some (Context) choose random names
    pdfPath  <- find ((==".pdf") . takeExtension) <$> getDirectoryContents path
    pdfFile  <- T.mapM (LC8.readFile . (path </>)) pdfPath

    logPath  <- find ((==".log") . takeExtension) <$> getDirectoryContents path
    logFile  <- T.mapM (C8.readFile . (path </>)) logPath

    return (a, parseLog $ fromMaybe "" logFile, pdfFile)

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

-- | Parse result from @\showthe@.
showthe :: Fractional n => ByteString -> OnlineTex n
showthe str = do
  clearUnblocking
  texPutStrLn $ "\\showthe" <> str
  onlineTexParser parseUnit

-- | Dimensions from filling the current line.
hsize :: Fractional n => OnlineTex n
hsize = boxWidth <$> hbox "\\line{\\hfill}"

-- | Run an Attoparsec parser on Tex's output.
onlineTexParser :: A.Parser a -> OnlineTex a
onlineTexParser p = getInStream >>= liftIO . parseFromStream p
  -- TODO: have a timeout

texPutStrLn :: ByteString -> OnlineTex ()
texPutStrLn a = getOutStream >>= liftIO . write (Just $ C8.append a "\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 = reader fst

-- | Get the input stream to give text to tex.
getInStream :: OnlineTex (InputStream ByteString)
getInStream = reader snd

-- | Clear any output tex has already given.
clearUnblocking :: OnlineTex ()
clearUnblocking = getInStream >>= void . liftIO . 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 dir env command args preamble = do

  -- Tex doesn't send anything to stderr
  (outStream, inStream, _, h) <- runInteractiveProcess'
                                   command
                                   args
                                   (Just dir)
                                   env

  -- inStream <- debugStream inStream'

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

  return (outStream, inStream, 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' cmd args wd env = do
    (hin, hout, herr, ph) <- P.runInteractiveProcess cmd args wd env

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

    sIn  <- Streams.handleToOutputStream hin >>=
            Streams.atEndOfOutput (hClose hin) >>=
            Streams.lockingOutputStream
    sOut <- Streams.handleToInputStream hout >>=
            Streams.atEndOfInput (hClose hout) >>=
            Streams.lockingInputStream
    sErr <- Streams.handleToInputStream herr >>=
            Streams.atEndOfInput (hClose herr) >>=
            Streams.lockingInputStream

    return (sIn, sOut, sErr, ph)

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