{-# LANGUAGE CPP, ForeignFunctionInterface, PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.CSL.Input.Bibutils
-- Copyright   :  (C) 2008 Andrea Rossato
-- License     :  BSD3
--
-- Maintainer  :  andrea.rossato@unitn.it
-- Stability   :  unstable
-- Portability :  unportable
--
-----------------------------------------------------------------------------

module Text.CSL.Input.Bibutils
    ( readBiblioFile
    ) where

import Text.CSL.Reference
import Text.CSL.Input.MODS

#ifdef USE_BIBUTILS
import Data.Char
import System.Directory ( getTemporaryDirectory, removeFile )
import System.FilePath ( takeExtension, (</>) )
import System.IO
import Text.Bibutils
#endif

-- | Read a file with a bibliographic database of the format specified
-- by the 'String'. If the 'String' is empty the file extension will
-- be used to identify the format.
--
-- Supported formats are: @\"mods\"@, @\"bibtex\"@, @\"biblatex\"@,
-- @\"ris\"@, @\"endnote\"@, @\"endnotexml\"@, @\"isi\"@,
-- @\"medline\"@, and @\"copac\"@.
readBiblioFile :: FilePath -> String -> IO [Reference]
#ifdef USE_BIBUTILS
readBiblioFile f m
    |   [] <- m = let mode = case takeExtension (map toLower f) of
                               ".mods"    -> mods_in
                               ".bib"     -> bibtex_in
                               ".bbx"     -> biblatex_in
                               ".ris"     -> ris_in
                               ".enl"     -> endnote_in
                               ".xml"     -> endnotexml_in
                               ".wos"     -> isi_in
                               ".medline" -> medline_in
                               ".copac"   -> copac_in
                               _          -> error "Bibliography format not supported."
                  in readBiblioFile' f mode
    | otherwise = let mode = case m of
                               "mods"       -> mods_in
                               "bibtex"     -> bibtex_in
                               "biblatex"   -> biblatex_in
                               "ris"        -> ris_in
                               "endnote"    -> endnote_in
                               "endnotexml" -> endnotexml_in
                               "isi"        -> isi_in
                               "medline"    -> medline_in
                               "copac"      -> copac_in
                               _            -> error "Bibliography format not supported."
                  in readBiblioFile' f mode

#else
readBiblioFile f m
    | "mods" <- m = readModsColletionFile f
    | otherwise   = error $ "Bibliography format not supported.\n" ++
                            "citeproc-hs was not compiled with bibutils support"
#endif

#ifdef USE_BIBUTILS
readBiblioFile' :: FilePath -> BiblioIn -> IO [Reference]
readBiblioFile' fin bin
    | bin == mods_in = readModsColletionFile fin
    | otherwise      = do
   tdir  <- getTemporaryDirectory
   (f,h) <- openTempFile tdir "citeproc.txt"
   hClose h
   let tfile = tdir </> f
   param <- bibl_initparams bin mods_out "citeproc-hs"
   bibl  <- bibl_init
   unsetBOM   param
   bibl_read  param bibl fin
   bibl_write param bibl tfile
   bibl_free bibl
   bibl_freeparams param
   refs <- readModsColletionFile tfile
   removeFile tfile
   return refs
#endif