{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module PDF.Content.Operator (
      Instruction
    , Operator
    , operator
  ) where

import Control.Monad.Fail (MonadFail(..))
import Control.Monad.State (MonadState(..))
import Data.ByteString.Char8 (ByteString, pack, unpack)
import Data.Char (toLower)
import Data.Map (Map, (!?))
import qualified Data.Map as Map (fromList)
import qualified PDF.Content.Operator.Color as Color (Operator, signature)
import PDF.Content.Operator.Common (Signature)
import qualified PDF.Content.Operator.GraphicState as GraphicState (Operator, signature)
import qualified PDF.Content.Operator.Path as Path (Operator, signature)
import qualified PDF.Content.Operator.Text as Text (Operator, signature)
import PDF.Object (DirectObject, blank, regular)
import PDF.Parser (MonadParser, takeAll1)
import Prelude hiding (fail)
import Text.Printf (printf)

data Operator =
    GraphicState GraphicState.Operator
  | Path Path.Operator
  | Color Color.Operator
  | Text Text.Operator 
  deriving Show

type Instruction = (Operator, [DirectObject])

operatorsTable :: Map ByteString (Signature Operator)
operatorsTable = Map.fromList (
      (prepare GraphicState <$> GraphicState.signature)
    ++ (prepare Path <$> Path.signature)
    ++ (prepare Color <$> Color.signature)
    ++ (prepare Text <$> Text.signature)
  )
  where
    prepare constructor (op, sig) = (code op, (constructor op, sig))

code :: Show a => a -> ByteString
code = pack . expand . show
  where
    expand "" = ""
    expand (c:'_':s) = toLower c : expand s
    expand ('s':'t':'a':'r':s) = '*' : expand s
    expand ('Q':'u':'o':'t':'e':s) = '\'' : expand s
    expand ('D':'Q':'u':'o':'t':'e':s) = '"' : expand s
    expand (c:s) = c : expand s

type StackParser m = (MonadState [DirectObject] m, MonadParser m)

operator :: StackParser m => m Instruction
operator = do
  chunk <- takeAll1 regular <* blank
  args <- reverse <$> get
  case operatorsTable !? chunk of
    Just (op, sig)
      | sig args -> return (op, args)
      | otherwise -> 
        get >>= fail . printf "Operator %s with stack %s" (show op) . show
    _ -> fail ("Unknown chunk " ++ unpack chunk)