{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : PDF.Outlines
Description : Function to get /Outlines object
Copyright   : (c) Keiichiro Shikano, 2016
License     : MIT
Maintainer  : k16.shikano@gmail.com

Function to grub /Outlines in PDF trailer. It mainly provides texts for Table of Contents.
-}

module PDF.Outlines
       ( getOutlines
       ) where

import Debug.Trace

import Data.List (find)
import Data.Attoparsec.ByteString hiding (inClass, notInClass, satisfy)
import Data.Attoparsec.ByteString.Char8
import Data.Attoparsec.Combinator
import qualified Data.ByteString.Char8 as BS

import PDF.Definition hiding (toString)
import PDF.DocumentStructure
import PDF.Object (parseRefsArray, parsePdfLetters)
import PDF.PDFIO

data PDFOutlines = PDFOutlinesTree [PDFOutlines]
                 | PDFOutlinesEntry { PDFOutlines -> Int
dest :: Int
                                    , PDFOutlines -> String
text :: String
                                    , PDFOutlines -> PDFOutlines
subs :: PDFOutlines
                                    }
                 | PDFOutlinesNE

instance Show PDFOutlines where
  show :: PDFOutlines -> String
show = Int -> PDFOutlines -> String
toString Int
0

toString :: Int -> PDFOutlines -> String
toString :: Int -> PDFOutlines -> String
toString Int
depth PDFOutlinesEntry {dest :: PDFOutlines -> Int
dest=Int
d, text :: PDFOutlines -> String
text=String
t, subs :: PDFOutlines -> PDFOutlines
subs=PDFOutlines
s} = (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
depth Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> PDFOutlines -> String
toString (Int
depthInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) PDFOutlines
s
toString Int
depth (PDFOutlinesTree [PDFOutlines]
os) = (PDFOutlines -> String) -> [PDFOutlines] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> PDFOutlines -> String
toString Int
depth) [PDFOutlines]
os
toString Int
depth PDFOutlines
PDFOutlinesNE = String
""

-- | Get information of \/Outlines from 'filename'

getOutlines :: FilePath -> IO PDFOutlines
getOutlines :: String -> IO PDFOutlines
getOutlines String
filename = do
  Dict
dict <- String -> IO Dict
outlineObjFromFile String
filename
  [PDFObj]
objs <- String -> IO [PDFObj]
getPDFObjFromFile String
filename  
  Int
firstref <- case Dict -> Maybe Int
findFirst Dict
dict of
    Just Int
r -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
r
    Maybe Int
Nothing -> String -> IO Int
forall a. HasCallStack => String -> a
error String
"No top level outline entry."
  Dict
firstdict <- case Int -> [PDFObj] -> Maybe [Obj]
findObjsByRef Int
firstref [PDFObj]
objs of
    Just [PdfDict Dict
d] -> Dict -> IO Dict
forall (m :: * -> *) a. Monad m => a -> m a
return Dict
d
    Just [Obj]
s -> String -> IO Dict
forall a. HasCallStack => String -> a
error (String -> IO Dict) -> String -> IO Dict
forall a b. (a -> b) -> a -> b
$ String
"Unknown Object: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Obj] -> String
forall a. Show a => a -> String
show [Obj]
s
    Maybe [Obj]
Nothing -> String -> IO Dict
forall a. HasCallStack => String -> a
error (String -> IO Dict) -> String -> IO Dict
forall a b. (a -> b) -> a -> b
$ String
"No Object with Ref " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
firstref
  PDFOutlines -> IO PDFOutlines
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFOutlines -> IO PDFOutlines) -> PDFOutlines -> IO PDFOutlines
forall a b. (a -> b) -> a -> b
$ Dict -> [PDFObj] -> PDFOutlines
gatherOutlines Dict
firstdict [PDFObj]
objs

gatherChildren :: Dict -> [PDFObj] -> PDFOutlines
gatherChildren Dict
dict [PDFObj]
objs = case Dict -> Maybe Int
findFirst Dict
dict of
  Just Int
r -> case Int -> [PDFObj] -> Maybe [Obj]
findObjsByRef Int
r [PDFObj]
objs of
    Just [PdfDict Dict
d] -> Dict -> [PDFObj] -> PDFOutlines
gatherOutlines Dict
d [PDFObj]
objs
    Just [Obj]
s -> String -> PDFOutlines
forall a. HasCallStack => String -> a
error (String -> PDFOutlines) -> String -> PDFOutlines
forall a b. (a -> b) -> a -> b
$ String
"Unknown Object at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r
    Maybe [Obj]
Nothing -> String -> PDFOutlines
forall a. HasCallStack => String -> a
error (String -> PDFOutlines) -> String -> PDFOutlines
forall a b. (a -> b) -> a -> b
$ String
"No Object with Ref " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r
  Maybe Int
Nothing -> PDFOutlines
PDFOutlinesNE

gatherOutlines :: Dict -> [PDFObj] -> PDFOutlines
gatherOutlines Dict
dict [PDFObj]
objs =
  let c :: PDFOutlines
c = Dict -> [PDFObj] -> PDFOutlines
gatherChildren Dict
dict [PDFObj]
objs
  in case Dict -> Maybe Int
findNext Dict
dict of 
    Just Int
r -> case Int -> [PDFObj] -> Maybe [Obj]
findObjsByRef Int
r [PDFObj]
objs of
      Just [PdfDict Dict
d] -> [PDFOutlines] -> PDFOutlines
PDFOutlinesTree (PDFOutlinesEntry :: Int -> String -> PDFOutlines -> PDFOutlines
PDFOutlinesEntry { dest :: Int
dest = [Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Dict -> [Int]
findDest Dict
dict
                                                            , text :: String
text = Dict -> [PDFObj] -> String
findTitle Dict
dict [PDFObj]
objs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
                                                            , subs :: PDFOutlines
subs = PDFOutlines
c}
                                           PDFOutlines -> [PDFOutlines] -> [PDFOutlines]
forall a. a -> [a] -> [a]
: [Dict -> [PDFObj] -> PDFOutlines
gatherOutlines Dict
d [PDFObj]
objs])
      Just [Obj]
s -> String -> PDFOutlines
forall a. HasCallStack => String -> a
error (String -> PDFOutlines) -> String -> PDFOutlines
forall a b. (a -> b) -> a -> b
$ String
"Unknown Object at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r
      Maybe [Obj]
Nothing -> String -> PDFOutlines
forall a. HasCallStack => String -> a
error (String -> PDFOutlines) -> String -> PDFOutlines
forall a b. (a -> b) -> a -> b
$ String
"No Object with Ref " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r
    Maybe Int
Nothing -> PDFOutlinesEntry :: Int -> String -> PDFOutlines -> PDFOutlines
PDFOutlinesEntry { dest :: Int
dest = [Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Dict -> [Int]
findDest Dict
dict
                                , text :: String
text = Dict -> [PDFObj] -> String
findTitle Dict
dict [PDFObj]
objs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
                                , subs :: PDFOutlines
subs = PDFOutlines
c}

outlines :: Dict -> Int
outlines :: Dict -> Int
outlines Dict
dict = case ((Obj, Obj) -> Bool) -> Dict -> Maybe (Obj, Obj)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Obj, Obj) -> Bool
isOutlinesRef Dict
dict of
  Just (Obj
_, ObjRef Int
x) -> Int
x
  Just (Obj, Obj)
s -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"Unknown Object: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Obj, Obj) -> String
forall a. Show a => a -> String
show (Obj, Obj)
s
  Maybe (Obj, Obj)
Nothing            -> String -> Int
forall a. HasCallStack => String -> a
error String
"There seems no /Outlines in the root"
  where
    isOutlinesRef :: (Obj, Obj) -> Bool
isOutlinesRef (PdfName String
"/Outlines", ObjRef Int
x) = Bool
True
    isOutlinesRef (Obj
_,Obj
_)                           = Bool
False

outlineObjFromFile :: String -> IO Dict
outlineObjFromFile :: String -> IO Dict
outlineObjFromFile String
filename = do
  [PDFObj]
objs <- String -> IO [PDFObj]
getPDFObjFromFile String
filename
  Int
rootref <- String -> IO Int
getRootRef String
filename
  [Obj]
rootobj <- case Int -> [PDFObj] -> Maybe [Obj]
findObjsByRef Int
rootref [PDFObj]
objs of
    Just [Obj]
os -> [Obj] -> IO [Obj]
forall (m :: * -> *) a. Monad m => a -> m a
return [Obj]
os
    Maybe [Obj]
Nothing -> String -> IO [Obj]
forall a. HasCallStack => String -> a
error String
"Could not get root object."
  Int
outlineref <- case [Obj] -> Maybe Dict
findDict [Obj]
rootobj of
    Just Dict
dict -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Dict -> Int
outlines Dict
dict
    Maybe Dict
Nothing   -> String -> IO Int
forall a. HasCallStack => String -> a
error String
"Something wrong..."
  case Int -> [PDFObj] -> Maybe [Obj]
findObjsByRef Int
outlineref [PDFObj]
objs of
    Just [PdfDict Dict
d] -> Dict -> IO Dict
forall (m :: * -> *) a. Monad m => a -> m a
return Dict
d
    Just [Obj]
s -> String -> IO Dict
forall a. HasCallStack => String -> a
error (String -> IO Dict) -> String -> IO Dict
forall a b. (a -> b) -> a -> b
$ String
"Unknown Object: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Obj] -> String
forall a. Show a => a -> String
show [Obj]
s
    Maybe [Obj]
Nothing -> String -> IO Dict
forall a. HasCallStack => String -> a
error String
"Could not get outlines object"

findTitle :: Dict -> [PDFObj] -> String
findTitle Dict
dict [PDFObj]
objs = 
  case Dict -> String -> Maybe Obj
findObjFromDict Dict
dict String
"/Title" of
    Just (PdfText String
s) -> case Parser String -> ByteString -> Either String String
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser String
parsePdfLetters (String -> ByteString
BS.pack String
s) of
      Right String
t -> String
t
      Left String
err -> String
s
    Just (ObjRef Int
r) -> case Int -> [PDFObj] -> Maybe [Obj]
findObjsByRef Int
r [PDFObj]
objs of
      Just [PdfText String
s] -> String
s
      Just [Obj]
s -> ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"Unknown Object at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r
      Maybe [Obj]
Nothing -> ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"No title object in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r
    Just Obj
x -> Obj -> String
forall a. Show a => a -> String
show Obj
x
    Maybe Obj
Nothing -> ShowS
forall a. HasCallStack => String -> a
error String
"No title object."

findDest :: Dict -> [Int]
findDest Dict
dict = 
  case Dict -> String -> Maybe Obj
findObjFromDict Dict
dict String
"/Dest" of
    Just (PdfArray [Obj]
a) -> [Obj] -> [Int]
parseRefsArray [Obj]
a
    Just Obj
s -> String -> [Int]
forall a. HasCallStack => String -> a
error (String -> [Int]) -> String -> [Int]
forall a b. (a -> b) -> a -> b
$ String
"Unknown Object: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Obj -> String
forall a. Show a => a -> String
show Obj
s
    Maybe Obj
Nothing -> String -> [Int]
forall a. HasCallStack => String -> a
error String
"No destination object."

findNext :: Dict -> Maybe Int
findNext Dict
dict = 
  case Dict -> String -> Maybe Obj
findObjFromDict Dict
dict String
"/Next" of
    Just (ObjRef Int
x) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
    Just Obj
s -> String -> Maybe Int
forall a. HasCallStack => String -> a
error (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ String
"Unknown Object: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Obj -> String
forall a. Show a => a -> String
show Obj
s
    Maybe Obj
Nothing -> Maybe Int
forall a. Maybe a
Nothing

findFirst :: Dict -> Maybe Int
findFirst Dict
dict =
  case Dict -> String -> Maybe Obj
findObjFromDict Dict
dict String
"/First" of
    Just (ObjRef Int
x) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
    Just Obj
s -> String -> Maybe Int
forall a. HasCallStack => String -> a
error (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ String
"Unknown Object: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Obj -> String
forall a. Show a => a -> String
show Obj
s
    Maybe Obj
Nothing -> Maybe Int
forall a. Maybe a
Nothing