{-# LANGUAGE OverloadedStrings #-}
module PDF.Content (
      Content(..)
    , ContentUnit(..)
    , GraphicContextUnit(..)
    , TextContext
    , content
    , parse
  ) where

import Control.Applicative ((<|>))
import Control.Monad.State (evalStateT, modify)
import Data.Attoparsec.ByteString.Char8 (sepBy)
import Data.ByteString (ByteString)
import PDF.Content.Operator (Instruction, operator)
import PDF.Object (blank, directObject)
import PDF.Output (Output(..), line)
import PDF.Parser (MonadParser, evalParser, string)

data GraphicContextUnit =
    GraphicInstruction Instruction
  | ContentUnit ContentUnit
  deriving Show
type TextContext = [Instruction]
data ContentUnit =
    GraphicContext [GraphicContextUnit]
  | TextContext TextContext
  deriving Show
newtype Content = Content [ContentUnit] deriving Show

content :: MonadParser m => m Content
content = Content <$> contentUnit `sepBy` blank

contentUnit :: MonadParser m => m ContentUnit
contentUnit =
    (GraphicContext <$> graphicContext)
  <|> (TextContext <$> textContext)
  where
    graphicContext =
      string "q" *> blank *> graphicContextUnit `sepBy` blank <* blank <* string "Q"

graphicContextUnit :: MonadParser m => m GraphicContextUnit
graphicContextUnit =
    (GraphicInstruction <$> instruction)
  <|> (ContentUnit <$> contentUnit)

instruction :: MonadParser m => m Instruction
instruction = evalStateT stackParser []
  where
    stackParser = ((directObject <* blank) >>= push) <|> operator
    push arg = modify (arg:) *> stackParser

parse :: ByteString -> Either String Content
parse = evalParser content ()

textContext :: MonadParser m => m TextContext
textContext =
  string "BT" *> blank *> instruction `sepBy` blank <* blank <* string "ET"

instance Output Content where
  output (Content contentUnits) = output contentUnits

instance Output ContentUnit where
  output (GraphicContext gc) = line "q" `mappend` output gc `mappend` line "Q"
  output (TextContext tc) = line "BT" `mappend` output tc `mappend` line "ET"

instance Output GraphicContextUnit where
  output (GraphicInstruction gi) = output gi
  output (ContentUnit cu) = output cu