{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

----------------------------------------------------------------------------
-- |
-- Module      :  System.Texrunner.Parse
-- Copyright   :  (c) 2015 Christopher Chalmers
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  c.chalmers@me.com
--
-- Functions for parsing Tex output and logs. This log is parser is
-- experimental and largely untested. Please make an issue for any logs
-- that aren't parsed properly.
--
-----------------------------------------------------------------------------

module System.Texrunner.Parse
  ( -- * Box
    Box (..)
  , parseBox
    -- * Errors
  , TexLog (..)
  , TexInfo (..)
  , TexError (..)
  , TexError' (..)
  , someError
  , badBox
  , parseUnit
  , parseLog
  , prettyPrintLog
  ) where

import           Control.Applicative
import           Data.Attoparsec.ByteString.Char8 as A
import           Data.ByteString.Char8            (ByteString, cons, pack)
import qualified Data.ByteString.Char8            as B
import           Data.Maybe
import           Data.Semigroup

------------------------------------------------------------------------
-- Boxes
------------------------------------------------------------------------

-- | Data type for holding dimensions of a hbox. It is likely the
--   internal representation will change to allow nested boxes in the
--   future.
data Box n = Box
  { forall n. Box n -> n
boxHeight :: n
  , forall n. Box n -> n
boxDepth  :: n
  , forall n. Box n -> n
boxWidth  :: n
  } deriving Int -> Box n -> ShowS
forall n. Show n => Int -> Box n -> ShowS
forall n. Show n => [Box n] -> ShowS
forall n. Show n => Box n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Box n] -> ShowS
$cshowList :: forall n. Show n => [Box n] -> ShowS
show :: Box n -> String
$cshow :: forall n. Show n => Box n -> String
showsPrec :: Int -> Box n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Box n -> ShowS
Show

int :: Parser Int
int :: Parser Int
int = forall a. Integral a => Parser a
decimal

parseBox :: Fractional n => Parser (Box n)
parseBox :: forall n. Fractional n => Parser (Box n)
parseBox = do
  (Char -> Bool) -> Parser ByteString ()
A.skipWhile (forall a. Eq a => a -> a -> Bool
/=Char
'\\') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'\\'
  Parser (Box n)
parseSingle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall n. Fractional n => Parser (Box n)
parseBox
  where
    parseSingle :: Parser (Box n)
parseSingle = do
      Int
_ <- Parser ByteString ByteString
"box" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
int forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"=\n\\hbox("
      n
h <- forall a. Fractional a => Parser a
rational forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'+'
      n
d <- forall a. Fractional a => Parser a
rational forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
")x"
      n
w <- forall a. Fractional a => Parser a
rational
      --
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. n -> n -> n -> Box n
Box (forall n. Fractional n => n -> n
pt2bp n
h) (forall n. Fractional n => n -> n
pt2bp n
d) (forall n. Fractional n => n -> n
pt2bp n
w)

parseUnit :: Fractional n => Parser n
parseUnit :: forall a. Fractional a => Parser a
parseUnit = do
  (Char -> Bool) -> Parser ByteString ()
A.skipWhile (forall a. Eq a => a -> a -> Bool
/=Char
'>') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'>'
  Parser ByteString ()
skipSpace
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall n. Fractional n => n -> n
pt2bp forall a. Fractional a => Parser a
rational forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Fractional a => Parser a
parseUnit

pt2bp :: Fractional n => n -> n
pt2bp :: forall n. Fractional n => n -> n
pt2bp = (forall a. Fractional a => a -> a -> a
/n
1.00374)

------------------------------------------------------------------------
-- Logs
------------------------------------------------------------------------

-- Everything's done using ByteString because io-streams' attoparsec module
-- only has a ByteString function. It's very likely this will all change to
-- Text in the future.

data TexLog = TexLog
  { TexLog -> TexInfo
texInfo   :: TexInfo
  , TexLog -> Maybe Int
numPages  :: Maybe Int
  , TexLog -> [TexError]
texErrors :: [TexError]
  -- , rawLog    :: ByteString
  } deriving Int -> TexLog -> ShowS
[TexLog] -> ShowS
TexLog -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TexLog] -> ShowS
$cshowList :: [TexLog] -> ShowS
show :: TexLog -> String
$cshow :: TexLog -> String
showsPrec :: Int -> TexLog -> ShowS
$cshowsPrec :: Int -> TexLog -> ShowS
Show

data TexInfo = TexInfo
  { TexInfo -> Maybe ByteString
texCommand      :: Maybe ByteString
  , TexInfo -> Maybe ByteString
texVersion      :: Maybe ByteString
  , TexInfo -> Maybe ByteString
texDistribution :: Maybe ByteString
  -- , texDate    :: Maybe Date
  }
  deriving Int -> TexInfo -> ShowS
[TexInfo] -> ShowS
TexInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TexInfo] -> ShowS
$cshowList :: [TexInfo] -> ShowS
show :: TexInfo -> String
$cshow :: TexInfo -> String
showsPrec :: Int -> TexInfo -> ShowS
$cshowsPrec :: Int -> TexInfo -> ShowS
Show

-- Make shift way to parse a log by combining it in this way.
instance Semigroup TexLog where
  TexLog TexInfo
prog Maybe Int
pages1 [TexError]
errors1 <> :: TexLog -> TexLog -> TexLog
<> TexLog TexInfo
_ Maybe Int
pages2 [TexError]
errors2 =
    case (Maybe Int
pages1,Maybe Int
pages2) of
      (Just Int
a,Maybe Int
_) -> TexInfo -> Maybe Int -> [TexError] -> TexLog
TexLog TexInfo
prog (forall a. a -> Maybe a
Just Int
a) ([TexError]
errors1 forall a. [a] -> [a] -> [a]
++ [TexError]
errors2)
      (Maybe Int
_,Maybe Int
b)      -> TexInfo -> Maybe Int -> [TexError] -> TexLog
TexLog TexInfo
prog Maybe Int
b ([TexError]
errors1 forall a. [a] -> [a] -> [a]
++ [TexError]
errors2)

instance Monoid TexLog where
  mempty :: TexLog
mempty  = TexInfo -> Maybe Int -> [TexError] -> TexLog
TexLog (Maybe ByteString -> Maybe ByteString -> Maybe ByteString -> TexInfo
TexInfo forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing) forall a. Maybe a
Nothing []
  mappend :: TexLog -> TexLog -> TexLog
mappend = forall a. Semigroup a => a -> a -> a
(<>)

infoParser :: Parser TexInfo
infoParser :: Parser TexInfo
infoParser
  = Maybe ByteString -> Maybe ByteString -> Maybe ByteString -> TexInfo
TexInfo
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
"This is"   forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
takeTill (forall a. Eq a => a -> a -> Bool
== Char
',') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
anyChar)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
" Version " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
takeTill (forall a. Eq a => a -> a -> Bool
== Char
' ') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
anyChar)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Char
char Char
'('    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
takeTill (forall a. Eq a => a -> a -> Bool
== Char
')') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
anyChar)
  -- <*> Nothing

logFile :: Parser TexLog
logFile :: Parser TexLog
logFile = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TexLog
logLine
  where
    logLine :: Parser TexLog
logLine = do
      TexInfo
info   <- Parser TexInfo
infoParser
      Maybe Int
pages  <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
nPages
      [TexError]
errors <- forall a. Maybe a -> [a]
maybeToList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser TexError
someError
      ByteString
_      <- Parser ByteString ByteString
restOfLine
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TexInfo -> Maybe Int -> [TexError] -> TexLog
TexLog TexInfo
info Maybe Int
pages [TexError]
errors

-- thisIs :: Parser TexVersion

parseLog :: ByteString -> TexLog
parseLog :: ByteString -> TexLog
parseLog = (\(Right TexLog
a) -> TexLog
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either String a
parseOnly Parser TexLog
logFile
-- the parse should never fail (I think)

prettyPrintLog :: TexLog -> ByteString
prettyPrintLog :: TexLog -> ByteString
prettyPrintLog TexLog {[TexError]
Maybe Int
TexInfo
texErrors :: [TexError]
numPages :: Maybe Int
texInfo :: TexInfo
texErrors :: TexLog -> [TexError]
numPages :: TexLog -> Maybe Int
texInfo :: TexLog -> TexInfo
..} =
  forall a. a -> Maybe a -> a
fromMaybe ByteString
"unknown program" (TexInfo -> Maybe ByteString
texCommand TexInfo
texInfo)
  forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (ByteString
" version " forall a. Semigroup a => a -> a -> a
<>) (TexInfo -> Maybe ByteString
texVersion TexInfo
texInfo)
  forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (ByteString
" " forall a. Semigroup a => a -> a -> a
<>) (TexInfo -> Maybe ByteString
texDistribution TexInfo
texInfo)
  forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
  forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" ((forall a. Semigroup a => a -> a -> a
<> ByteString
"pages\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe Int
numPages
  forall a. Semigroup a => a -> a -> a
<> [ByteString] -> ByteString
B.unlines (forall a b. (a -> b) -> [a] -> [b]
map (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [TexError]
texErrors)

------------------------------------------------------------------------
-- Errors
------------------------------------------------------------------------

-- | An error from tex with possible line number.
data TexError = TexError
  { TexError -> Maybe Int
errorLine :: Maybe Int
  , TexError -> TexError'
error'    :: TexError'
  }
  deriving Int -> TexError -> ShowS
[TexError] -> ShowS
TexError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TexError] -> ShowS
$cshowList :: [TexError] -> ShowS
show :: TexError -> String
$cshow :: TexError -> String
showsPrec :: Int -> TexError -> ShowS
$cshowsPrec :: Int -> TexError -> ShowS
Show

instance Eq TexError where
  TexError Maybe Int
_ TexError'
a == :: TexError -> TexError -> Bool
== TexError Maybe Int
_ TexError'
b = TexError'
a forall a. Eq a => a -> a -> Bool
== TexError'
b

-- | A subset of possible error Tex can throw.
data TexError'
  = UndefinedControlSequence ByteString
  | MissingNumber
  | Missing Char
  | IllegalUnit -- (Maybe Char) (Maybe Char)
  | PackageError String String
  | LatexError ByteString
  | BadBox ByteString
  | EmergencyStop
  | ParagraphEnded
  | TooMany ByteString
  | DimensionTooLarge
  | TooManyErrors
  | NumberTooBig
  | ExtraBrace
  | FatalError ByteString
  | UnknownError ByteString
  deriving (Int -> TexError' -> ShowS
[TexError'] -> ShowS
TexError' -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TexError'] -> ShowS
$cshowList :: [TexError'] -> ShowS
show :: TexError' -> String
$cshow :: TexError' -> String
showsPrec :: Int -> TexError' -> ShowS
$cshowsPrec :: Int -> TexError' -> ShowS
Show, ReadPrec [TexError']
ReadPrec TexError'
Int -> ReadS TexError'
ReadS [TexError']
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TexError']
$creadListPrec :: ReadPrec [TexError']
readPrec :: ReadPrec TexError'
$creadPrec :: ReadPrec TexError'
readList :: ReadS [TexError']
$creadList :: ReadS [TexError']
readsPrec :: Int -> ReadS TexError'
$creadsPrec :: Int -> ReadS TexError'
Read, TexError' -> TexError' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TexError' -> TexError' -> Bool
$c/= :: TexError' -> TexError' -> Bool
== :: TexError' -> TexError' -> Bool
$c== :: TexError' -> TexError' -> Bool
Eq)

-- | Parse any line beginning with "! ". Any unknown errors are returned as 'UnknownError'.
someError :: Parser TexError
someError :: Parser TexError
someError =  Parser ByteString ByteString
mark forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TexError
errors
  where
    -- in context exclamation mark isn't always at the beginning
    mark :: Parser ByteString ByteString
mark = Parser ByteString ByteString
"! " forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
notChar Char
'\n' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
mark)
    errors :: Parser TexError
errors =  Parser TexError
undefinedControlSequence
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TexError
illegalUnit
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TexError
missingNumber
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TexError
missing
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TexError
latexError
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TexError
emergencyStop
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TexError
extraBrace
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TexError
paragraphEnded
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TexError
numberTooBig
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TexError
tooMany
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TexError
dimensionTooLarge
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TexError
tooManyErrors
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TexError
fatalError
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int -> TexError' -> TexError
TexError forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> TexError'
UnknownError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
restOfLine

noteStar :: Parser ()
noteStar :: Parser ByteString ()
noteStar = Parser ByteString ()
skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"<*>" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
skipSpace

toBeReadAgain :: Parser Char
toBeReadAgain :: Parser Char
toBeReadAgain = do
  Parser ByteString ()
skipSpace
  ByteString
_ <- Parser ByteString ByteString
"<to be read again>"
  Parser ByteString ()
skipSpace
  Parser Char
anyChar

-- insertedText :: Parser ByteString
-- insertedText = do
--   skipSpace
--   _ <- "<inserted text>"
--   skipSpace
--   restOfLine

------------------------------------------------------------------------
-- Error parsers
------------------------------------------------------------------------

undefinedControlSequence :: Parser TexError
undefinedControlSequence :: Parser TexError
undefinedControlSequence = do
  ByteString
_ <- Parser ByteString ByteString
"Undefined control sequence"
  Maybe ByteString
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ByteString
"."

  Maybe Int
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do -- for context log
    Parser ByteString ()
skipSpace
    ByteString
_ <- Parser ByteString ByteString
"system"
    let skipLines :: Parser Int
skipLines = Parser Int
line forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
restOfLine forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
skipLines
    Parser Int
skipLines

  Maybe ()
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
noteStar
  Parser ByteString ()
skipSpace
  Maybe Int
l <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
line
  Parser ByteString ()
skipSpace
  ByteString
cs <- Parser ByteString ByteString
finalControlSequence
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Int -> TexError' -> TexError
TexError Maybe Int
l (ByteString -> TexError'
UndefinedControlSequence ByteString
cs)

finalControlSequence :: Parser ByteString
finalControlSequence :: Parser ByteString ByteString
finalControlSequence = forall a. [a] -> a
last forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString ByteString
controlSequence
  where
    controlSequence :: Parser ByteString ByteString
controlSequence = Char -> ByteString -> ByteString
cons Char
'\\' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (Char -> Parser Char
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
takeTill (\Char
x -> Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
|| Char
xforall a. Eq a => a -> a -> Bool
==Char
'\\'))

illegalUnit :: Parser TexError
illegalUnit :: Parser TexError
illegalUnit = do
  ByteString
_ <- Parser ByteString ByteString
"Illegal unit of measure (pt inserted)"
  Maybe Char
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Char
toBeReadAgain
  Maybe Char
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Char
toBeReadAgain

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Int -> TexError' -> TexError
TexError forall a. Maybe a
Nothing TexError'
IllegalUnit

missingNumber :: Parser TexError
missingNumber :: Parser TexError
missingNumber = do
  ByteString
_ <- Parser ByteString ByteString
"Missing number, treated as zero"
  Maybe Char
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Char
toBeReadAgain
  Maybe ()
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
noteStar
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Int -> TexError' -> TexError
TexError forall a. Maybe a
Nothing TexError'
MissingNumber

badBox :: Parser TexError
badBox :: Parser TexError
badBox = do
  ByteString
s <- forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser ByteString ByteString
"Underfull", Parser ByteString ByteString
"Overfull", Parser ByteString ByteString
"Tight", Parser ByteString ByteString
"Loose"]
  ByteString
_ <- Parser ByteString ByteString
" \\hbox " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
char Char
'(' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
takeTill (forall a. Eq a => a -> a -> Bool
==Char
')') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
')'
  Maybe Int
l <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
line
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Int -> TexError' -> TexError
TexError Maybe Int
l (ByteString -> TexError'
BadBox ByteString
s)

missing :: Parser TexError
missing :: Parser TexError
missing = do
  Char
c <- Parser ByteString ByteString
"Missing " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char
anyChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
" inserted"
  Maybe Int
l <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
line
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Int -> TexError' -> TexError
TexError Maybe Int
l (Char -> TexError'
Missing Char
c)

line :: Parser Int
line :: Parser Int
line =  Parser ByteString ByteString
" detected at line " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Integral a => Parser a
decimal
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"l."                 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Integral a => Parser a
decimal

emergencyStop :: Parser TexError
emergencyStop :: Parser TexError
emergencyStop = Parser ByteString ByteString
"Emergency stop"
             forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> TexError' -> TexError
TexError forall a. Maybe a
Nothing TexError'
EmergencyStop)

fatalError :: Parser TexError
fatalError :: Parser TexError
fatalError = Maybe Int -> TexError' -> TexError
TexError forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> TexError'
FatalError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
" ==> Fatal error occurred, " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
restOfLine)

-- line 8058 tex.web
extraBrace :: Parser TexError
extraBrace :: Parser TexError
extraBrace = Parser ByteString ByteString
"Argument of" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> TexError' -> TexError
TexError forall a. Maybe a
Nothing TexError'
ExtraBrace)

tooMany :: Parser TexError
tooMany :: Parser TexError
tooMany = Maybe Int -> TexError' -> TexError
TexError forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> TexError'
TooMany forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"Too Many " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
takeTill (forall a. Eq a => a -> a -> Bool
==Char
'\''))

tooManyErrors :: Parser TexError
tooManyErrors :: Parser TexError
tooManyErrors = Parser ByteString ByteString
"That makes 100 errors; please try again"
             forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> TexError' -> TexError
TexError forall a. Maybe a
Nothing TexError'
TooManyErrors)

dimensionTooLarge :: Parser TexError
dimensionTooLarge :: Parser TexError
dimensionTooLarge = Parser ByteString ByteString
"Dimension too large"
                 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> TexError' -> TexError
TexError forall a. Maybe a
Nothing TexError'
DimensionTooLarge)

-- line 8075 tex.web
paragraphEnded :: Parser TexError
paragraphEnded :: Parser TexError
paragraphEnded = do
  ByteString
_ <- Parser ByteString ByteString
"Paragraph ended before "
  ByteString
_ <- (Char -> Bool) -> Parser ByteString ByteString
takeTill Char -> Bool
isSpace
  Char
_ <- Parser Char
toBeReadAgain
  Maybe Int
l <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
line
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Int -> TexError' -> TexError
TexError Maybe Int
l TexError'
ParagraphEnded

numberTooBig :: Parser TexError
numberTooBig :: Parser TexError
numberTooBig = Parser ByteString ByteString
"Number too big"
            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> TexError' -> TexError
TexError forall a. Maybe a
Nothing TexError'
NumberTooBig)

-- Latex errors

latexError :: Parser TexError
latexError :: Parser TexError
latexError = Maybe Int -> TexError' -> TexError
TexError forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> TexError'
LatexError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"Latex Error: " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
restOfLine)

-- Pages

nPages :: Parser Int
nPages :: Parser Int
nPages = Parser ByteString ByteString
"Output written on "
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ()
skipWhile (forall a. Eq a => a -> a -> Bool
/= Char
'(') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
char Char
'('
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Integral a => Parser a
decimal

-- Utilities

restOfLine :: Parser ByteString
restOfLine :: Parser ByteString ByteString
restOfLine = (Char -> Bool) -> Parser ByteString ByteString
takeTill (forall a. Eq a => a -> a -> Bool
==Char
'\n') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'\n'