{-# LANGUAGE OverloadedStrings #-}

module PDF.Outlines
       ( getOutlines
       ) where

import Debug.Trace

import Data.List (find)
import PDF.Definition
import PDF.Object
import PDF.PDFIO

data PDFOutlines = PDFOutlinesTree [PDFOutlines]
                 | PDFOutlinesEntry { dest :: Int
                                    , text :: String
                                    , subs :: PDFOutlines
                                    }
                 | PDFOutlinesNE
                 deriving (Show)

getOutlines filename = do
  dict <- outlineObjFromFile filename
  objs <- getPDFObjFromFile filename  
  firstref <- case findFirst dict of
    Just r -> return r
    Nothing -> error "No top level outline entry."
  firstdict <- case findObjsByRef firstref objs of
    Just [PdfDict d] -> return $ d
    Nothing -> error $ "No Object with Ref " ++ show firstref
  showOutlines 0 $ gatherOutlines firstdict objs

gatherChildren dict objs = case findFirst dict of
  Just r -> case findObjsByRef r objs of
    Just [PdfDict d] -> gatherOutlines d objs
    Nothing -> error $ "No Object with Ref " ++ show r
  Nothing -> PDFOutlinesNE

gatherOutlines dict objs =
  let c = gatherChildren dict objs
  in case findNext dict of 
    Just r -> case findObjsByRef r objs of
      Just [PdfDict d] -> PDFOutlinesTree (PDFOutlinesEntry { dest = head $ findDest dict
                                                            , text = findTitle dict objs
                                                            , subs = c}
                                           : [gatherOutlines d objs])
      Nothing -> error $ "No Object with Ref " ++ show r
    Nothing -> PDFOutlinesEntry { dest = head $ findDest dict
                                , text = findTitle dict objs
                                , subs = PDFOutlinesNE}

showOutlines :: Int -> PDFOutlines -> IO ()
showOutlines depth (PDFOutlinesEntry {dest=d, text=t, subs=s}) = putStrLn (replicate depth ' ' ++ t) >> showOutlines (depth+1) s
showOutlines depth (PDFOutlinesTree os) = mapM_ (showOutlines (depth)) os
showOutlines depth PDFOutlinesNE = putStr ""

outlines :: Dict -> Int
outlines dict = case find isOutlinesRef dict of
  Just (_, ObjRef x) -> x
  Nothing            -> error "There seems no /Outlines in the root"
  where
    isOutlinesRef (PdfName "/Outlines", ObjRef x) = True
    isOutlinesRef (_,_)                           = False

outlineObjFromFile :: String -> IO Dict
outlineObjFromFile filename = do
  objs <- getPDFObjFromFile filename
  rootref <- getRootRef filename
  rootobj <- case findObjsByRef rootref objs of
    Just os -> return os
    Nothing -> error "Could not get root object."
  outlineref <- case findDict rootobj of
    Just dict -> return $ outlines dict
    Nothing   -> error "Something wrong..."
  case findObjsByRef outlineref objs of
    Just [PdfDict d] -> return d
    Nothing -> error "Could not get outlines object"

findTitle dict objs = 
  case findObjThroughDict dict "/Title" of
    Just (PdfText s) -> s
    Just (ObjRef r) -> case findObjsByRef r objs of
      Just [PdfText s] -> s
      Nothing -> error $ "No title object in "++(show r)
    Nothing -> error "No title object."

findDest dict = 
  case findObjThroughDict dict "/Dest" of
    Just (PdfArray a) -> parseRefsArray a
    Nothing -> error "No destination object."

findNext dict = 
  case findObjThroughDict dict "/Next" of
    Just (ObjRef x) -> Just x
    Nothing -> Nothing

findFirst dict =
  case findObjThroughDict dict "/First" of
    Just (ObjRef x) -> Just x
    Nothing -> Nothing