{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module PDF.Output (
      OBuilder
    , OContext(..)
    , Offset(..)
    , Output(..)
    , byteString
    , char
    , getOffsets
    , join
    , lift
    , newLine
    , nextLine
    , saveOffset
    , string
    , render
  ) where

--import Data.ByteString.Builder (Builder, char8, lazyByteString, string8)
import Data.ByteString.Builder (Builder, char8, lazyByteString, string8, toLazyByteString)
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as BS (length)
import Data.Int (Int64)
import Data.Map (Map)
import qualified Data.Map as Map (singleton)
-- #if MIN_VERSION_base(4,9,0)
-- import qualified Data.Semigroup as Sem
-- #endif
import Data.String (IsString(..))
--import Control.Monad.Reader (MonadReader(..), Reader, runReader)
--import Control.Monad.Reader (MonadReader(..), Reader, runReader)
--import Control.Monad.Reader (MonadReader(..), Reader, runReader)
import Control.Monad.RWS (RWS, runRWS, ask, get, listen, modify, tell)
import qualified PDF.EOL as EOL (Style(..))

data Offset = StartXRef | ObjectId Int deriving (Eq, Ord)

{-
incrOffset :: (Int64 -> Int64) -> OutputState 
-}

newtype OContext a = OContext (RWS EOL.Style (Map Offset Int64) Int64 a)
type OBuilder = OContext Builder

instance Functor OContext where
  fmap f (OContext oc) = OContext $ fmap f oc

instance Applicative OContext where
  pure = OContext . pure
  (<*>) (OContext f) (OContext a) = OContext (f <*> a)

instance Monad OContext where
  (>>=) (OContext a) f = OContext (a >>= (\x -> let OContext y = f x in y))

saveOffset :: Offset -> OContext ()
saveOffset offset = OContext $
  get >>= tell . Map.singleton offset

lift :: (a -> Builder) -> a -> OBuilder
lift f a = return (f a)

getOffsets :: OBuilder -> OContext (OBuilder, Map Offset Int64)
getOffsets (OContext builder) =
  OContext (listen builder >>= \(a, w) -> return (return a, w))

append :: OBuilder -> OBuilder -> OBuilder
append (OContext a) (OContext b) = OContext (mappend <$> a <*> b)

#if MIN_VERSION_base(4,11,0)
instance Semigroup OBuilder where
  (<>) = append
#endif

instance Monoid OBuilder where
  mempty = OContext (return mempty)
#if !(MIN_VERSION_base(4,11,0))
  mappend = append
#endif

instance IsString OBuilder where
  fromString = string

class Output a where
  output :: a -> OBuilder

instance Output OBuilder where
  output = id

instance Output Bool where
  output False = string "false"
  output True = string "true"

instance Output a => Output [a] where
  output = foldl mappend mempty . fmap output

join :: Output a => String -> [a] -> OBuilder
join _ [] = mempty
join _ [a] = output a
join separator (a:as) =
  output a `mappend` string separator `mappend` (join separator as)

newLine :: OBuilder
newLine = OContext $ buildEOL =<< ask
  where
    buildEOL EOL.CR = return (char8 '\r') <* modify (+1)
    buildEOL EOL.LF = return (char8 '\n') <* modify (+1)
    buildEOL EOL.CRLF = return (string8 "\r\n") <* modify (+2)

nextLine :: OBuilder -> OBuilder -> OBuilder
nextLine a b = a `mappend` newLine `mappend` b

char :: Char -> OBuilder
char c = lift char8 c <* OContext (modify (+1))

string :: String -> OBuilder
string s = lift string8 s <* OContext (modify (+ toEnum (length s)))

byteString :: ByteString -> OBuilder
byteString bs = lift lazyByteString bs <* OContext (modify (+ BS.length bs))

render :: Output a => EOL.Style -> a -> ByteString
render eolStyle a =
  let OContext builder = output a in
  let (outputByteString, _, _) = runRWS builder eolStyle 0 in
  toLazyByteString outputByteString