{-# LANGUAGE OverloadedStrings #-}
module PDF.Content.Text (
    renderText
  ) where

import Control.Monad (foldM)
import Control.Monad.Reader (ReaderT, asks, runReaderT)
import Control.Monad.State (MonadState(..), StateT, evalStateT)
import Data.Map ((!))
import Data.Text (Text)
import PDF.Content (Content(..), ContentUnit(..), GraphicContextUnit(..))
import PDF.Content.Operator (Instruction, Operator(..))
import PDF.Content.Operator.Text (Operator(..))
import PDF.Font (Font, FontSet, emptyFont)
import PDF.Object (DirectObject(..), StringObject, toByteString)

type RenderingContext = ReaderT FontSet (Either String)
type TextRenderingContext = StateT Font RenderingContext

decodeString :: StringObject -> TextRenderingContext Text
decodeString input = do
  font <- get
  either fail return . font $ toByteString input

renderText :: FontSet -> Content -> Either String [Text]
renderText fontSet (Content contentUnits) =
  runReaderT (concat <$> mapM renderContentUnit contentUnits) fontSet

renderContentUnit :: ContentUnit -> RenderingContext [Text]
renderContentUnit (GraphicContext graphicContextUnits) =
  concat <$> mapM renderGraphicContextUnit graphicContextUnits
renderContentUnit (TextContext instructions) =
  evalStateT (concat <$> mapM renderInstruction instructions) emptyFont

renderGraphicContextUnit :: GraphicContextUnit -> RenderingContext [Text]
renderGraphicContextUnit (GraphicInstruction _) = return []
renderGraphicContextUnit (ContentUnit contentUnit) =
  renderContentUnit contentUnit

renderInstruction :: Instruction -> StateT Font RenderingContext [Text]
renderInstruction (Text Tf, [NameObject fontName, _]) =
  asks (! fontName) >>= put >> return []

renderInstruction (Text Tstar, []) = return ["\n"]

renderInstruction (Text TJ, [Array arrayObject]) =
  replicate 1 <$> foldM appendText "" arrayObject
  where
    appendText t (StringObject outputString) =
      mappend t <$> decodeString outputString
    appendText t _ = return t

renderInstruction (Text Tj, [StringObject outputString]) =
  replicate 1 <$> decodeString outputString

renderInstruction (Text Quote, [StringObject outputString]) =
  (\t -> ["\n", t]) <$> decodeString outputString

renderInstruction (Text DQuote, [StringObject outputString]) =
  (\t -> ["\n", t]) <$> decodeString outputString

renderInstruction _ = return []