-- | Parse content stream

module Pdf.Content.Parser
(
  readNextOperator,
  parseContent,
)
where

import Pdf.Core.Exception
import Pdf.Core.Parsers.Object

import Pdf.Content.Ops

import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as Parser
import Control.Applicative
import Control.Monad
import Control.Exception hiding (throw)
import System.IO.Streams (InputStream)
import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.Attoparsec as Streams

-- | Read the next operator if any
readNextOperator :: InputStream Expr -> IO (Maybe Operator)
readNextOperator :: InputStream Expr -> IO (Maybe Operator)
readNextOperator InputStream Expr
is = String -> IO (Maybe Operator) -> IO (Maybe Operator)
forall a. String -> IO a -> IO a
message String
"readNextOperator" (IO (Maybe Operator) -> IO (Maybe Operator))
-> IO (Maybe Operator) -> IO (Maybe Operator)
forall a b. (a -> b) -> a -> b
$ [Object] -> IO (Maybe Operator)
go []
  where
  go :: [Object] -> IO (Maybe Operator)
go [Object]
args = do
    Maybe Expr
expr <- InputStream Expr -> IO (Maybe Expr)
forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream Expr
is
      -- XXX: it should be handled by stream creator
      IO (Maybe Expr)
-> (ParseException -> IO (Maybe Expr)) -> IO (Maybe Expr)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(Streams.ParseException String
msg) -> Corrupted -> IO (Maybe Expr)
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
msg [])
    case Maybe Expr
expr of
      Maybe Expr
Nothing -> case [Object]
args of
                   [] -> Maybe Operator -> IO (Maybe Operator)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Operator
forall a. Maybe a
Nothing
                   [Object]
_ -> Corrupted -> IO (Maybe Operator)
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO (Maybe Operator))
-> Corrupted -> IO (Maybe Operator)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted (String
"Args without op: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args) []
      Just (Obj Object
o) -> [Object] -> IO (Maybe Operator)
go (Object
o Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
: [Object]
args)
      Just (Op Op
o) -> Maybe Operator -> IO (Maybe Operator)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Operator -> IO (Maybe Operator))
-> Maybe Operator -> IO (Maybe Operator)
forall a b. (a -> b) -> a -> b
$ Operator -> Maybe Operator
forall a. a -> Maybe a
Just (Op
o, [Object] -> [Object]
forall a. [a] -> [a]
reverse [Object]
args)

-- | Parser expression in a content stream
parseContent :: Parser (Maybe Expr)
parseContent :: Parser (Maybe Expr)
parseContent = do
  Parser ()
skipSpace
  (Parser ()
forall t. Chunk t => Parser t ()
Parser.endOfInput Parser () -> Parser (Maybe Expr) -> Parser (Maybe Expr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Expr -> Parser (Maybe Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Expr
forall a. Maybe a
Nothing) Parser (Maybe Expr) -> Parser (Maybe Expr) -> Parser (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (Expr -> Maybe Expr)
-> Parser ByteString Expr -> Parser (Maybe Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr -> Maybe Expr
forall a. a -> Maybe a
Just ((Object -> Expr)
-> Parser ByteString Object -> Parser ByteString Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Object -> Expr
Obj Parser ByteString Object
parseObject Parser ByteString Expr
-> Parser ByteString Expr -> Parser ByteString Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
               (ByteString -> Expr)
-> Parser ByteString ByteString -> Parser ByteString Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Op -> Expr
Op (Op -> Expr) -> (ByteString -> Op) -> ByteString -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Op
toOp) ((Char -> Bool) -> Parser ByteString ByteString
Parser.takeWhile1 Char -> Bool
isRegularChar))

-- Treat comments as spaces
skipSpace :: Parser ()
skipSpace :: Parser ()
skipSpace = do
  Parser ()
Parser.skipSpace
  Parser ByteString [()] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString [()] -> Parser ())
-> Parser ByteString [()] -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser ByteString [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser () -> Parser ByteString [()])
-> Parser () -> Parser ByteString [()]
forall a b. (a -> b) -> a -> b
$ do
    Char
_ <- Char -> Parser Char
Parser.char Char
'%'
    (Char -> Bool) -> Parser ()
Parser.skipWhile ((Char -> Bool) -> Parser ()) -> (Char -> Bool) -> Parser ()
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r'
    Parser ()
Parser.skipSpace