--------------------------------------------------------------------------------
-- | Wraps pandocs bibiliography handling
--
-- In order to add a bibliography, you will need a bibliography file (e.g.
-- @.bib@) and a CSL file (@.csl@). Both need to be compiled with their
-- respective compilers ('biblioCompiler' and 'cslCompiler'). Then, you can
-- refer to these files when you use 'readPandocBiblio'. This function also
-- takes the reader options for completeness -- you can use
-- 'defaultHakyllReaderOptions' if you're unsure.
-- 'pandocBiblioCompiler' is a convenience wrapper which works like 'pandocCompiler',
-- but also takes paths to compiled bibliography and csl files.
{-# LANGUAGE Arrows                     #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Web.Pandoc.Biblio
    ( CSL
    , cslCompiler
    , Biblio (..)
    , biblioCompiler
    , readPandocBiblio
    , pandocBiblioCompiler
    ) where


--------------------------------------------------------------------------------
import           Control.Monad            (liftM, replicateM)
import           Data.Binary              (Binary (..))
import           Data.Typeable            (Typeable)
import           Hakyll.Core.Compiler
import           Hakyll.Core.Compiler.Internal
import           Hakyll.Core.Identifier
import           Hakyll.Core.Item
import           Hakyll.Core.Provider
import           Hakyll.Core.Writable
import           Hakyll.Web.Pandoc
import           Hakyll.Web.Pandoc.Binary ()
import qualified Text.CSL                 as CSL
import           Text.CSL.Pandoc          (processCites)
import           Text.Pandoc              (Pandoc, ReaderOptions (..),
                                           enableExtension, Extension (..))


--------------------------------------------------------------------------------
data CSL = CSL
    deriving (Int -> CSL -> ShowS
[CSL] -> ShowS
CSL -> String
(Int -> CSL -> ShowS)
-> (CSL -> String) -> ([CSL] -> ShowS) -> Show CSL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSL] -> ShowS
$cshowList :: [CSL] -> ShowS
show :: CSL -> String
$cshow :: CSL -> String
showsPrec :: Int -> CSL -> ShowS
$cshowsPrec :: Int -> CSL -> ShowS
Show, Typeable)


--------------------------------------------------------------------------------
instance Binary CSL where
    put :: CSL -> Put
put CSL = () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    get :: Get CSL
get     = CSL -> Get CSL
forall (m :: * -> *) a. Monad m => a -> m a
return CSL
CSL


--------------------------------------------------------------------------------
instance Writable CSL where
    -- Shouldn't be written.
    write :: String -> Item CSL -> IO ()
write _ _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


--------------------------------------------------------------------------------
cslCompiler :: Compiler (Item CSL)
cslCompiler :: Compiler (Item CSL)
cslCompiler = CSL -> Compiler (Item CSL)
forall a. a -> Compiler (Item a)
makeItem CSL
CSL


--------------------------------------------------------------------------------
newtype Biblio = Biblio [CSL.Reference]
    deriving (Int -> Biblio -> ShowS
[Biblio] -> ShowS
Biblio -> String
(Int -> Biblio -> ShowS)
-> (Biblio -> String) -> ([Biblio] -> ShowS) -> Show Biblio
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Biblio] -> ShowS
$cshowList :: [Biblio] -> ShowS
show :: Biblio -> String
$cshow :: Biblio -> String
showsPrec :: Int -> Biblio -> ShowS
$cshowsPrec :: Int -> Biblio -> ShowS
Show, Typeable)


--------------------------------------------------------------------------------
instance Binary Biblio where
    -- Ugly.
    get :: Get Biblio
get             = do
        Int
len <- Get Int
forall t. Binary t => Get t
get
        [Reference] -> Biblio
Biblio ([Reference] -> Biblio) -> Get [Reference] -> Get Biblio
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Reference -> Get [Reference]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len Get Reference
forall t. Binary t => Get t
get
    put :: Biblio -> Put
put (Biblio rs :: [Reference]
rs) = Int -> Put
forall t. Binary t => t -> Put
put ([Reference] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Reference]
rs) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Reference -> Put) -> [Reference] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Reference -> Put
forall t. Binary t => t -> Put
put [Reference]
rs


--------------------------------------------------------------------------------
instance Writable Biblio where
    -- Shouldn't be written.
    write :: String -> Item Biblio -> IO ()
write _ _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


--------------------------------------------------------------------------------
biblioCompiler :: Compiler (Item Biblio)
biblioCompiler :: Compiler (Item Biblio)
biblioCompiler = do
    String
filePath <- Compiler String
getResourceFilePath
    Biblio -> Compiler (Item Biblio)
forall a. a -> Compiler (Item a)
makeItem (Biblio -> Compiler (Item Biblio))
-> Compiler Biblio -> Compiler (Item Biblio)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Biblio -> Compiler Biblio
forall a. IO a -> Compiler a
unsafeCompiler ([Reference] -> Biblio
Biblio ([Reference] -> Biblio) -> IO [Reference] -> IO Biblio
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Bool) -> String -> IO [Reference]
CSL.readBiblioFile Text -> Bool
forall b. b -> Bool
idpred String
filePath)
  where
    -- This is a filter on citations.  We include all citations.
    idpred :: b -> Bool
idpred = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True


--------------------------------------------------------------------------------
readPandocBiblio :: ReaderOptions
                 -> Item CSL
                 -> Item Biblio
                 -> (Item String)
                 -> Compiler (Item Pandoc)
readPandocBiblio :: ReaderOptions
-> Item CSL -> Item Biblio -> Item String -> Compiler (Item Pandoc)
readPandocBiblio ropt :: ReaderOptions
ropt csl :: Item CSL
csl biblio :: Item Biblio
biblio item :: Item String
item = do
    -- Parse CSL file, if given
    Provider
provider <- CompilerRead -> Provider
compilerProvider (CompilerRead -> Provider)
-> Compiler CompilerRead -> Compiler Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler CompilerRead
compilerAsk
    Style
style <- IO Style -> Compiler Style
forall a. IO a -> Compiler a
unsafeCompiler (IO Style -> Compiler Style) -> IO Style -> Compiler Style
forall a b. (a -> b) -> a -> b
$
             Maybe Text -> String -> IO Style
CSL.readCSLFile Maybe Text
forall a. Maybe a
Nothing (String -> IO Style)
-> (Item CSL -> String) -> Item CSL -> IO Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Provider -> Identifier -> String
resourceFilePath Provider
provider) (Identifier -> String)
-> (Item CSL -> Identifier) -> Item CSL -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item CSL -> Identifier
forall a. Item a -> Identifier
itemIdentifier (Item CSL -> IO Style) -> Item CSL -> IO Style
forall a b. (a -> b) -> a -> b
$ Item CSL
csl

    -- We need to know the citation keys, add then *before* actually parsing the
    -- actual page. If we don't do this, pandoc won't even consider them
    -- citations!
    let Biblio refs :: [Reference]
refs = Item Biblio -> Biblio
forall a. Item a -> a
itemBody Item Biblio
biblio
    Pandoc
pandoc <- Item Pandoc -> Pandoc
forall a. Item a -> a
itemBody (Item Pandoc -> Pandoc)
-> Compiler (Item Pandoc) -> Compiler Pandoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderOptions -> Item String -> Compiler (Item Pandoc)
readPandocWith ReaderOptions
ropt Item String
item
    let pandoc' :: Pandoc
pandoc' = Style -> [Reference] -> Pandoc -> Pandoc
processCites Style
style [Reference]
refs Pandoc
pandoc

    Item Pandoc -> Compiler (Item Pandoc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Item Pandoc -> Compiler (Item Pandoc))
-> Item Pandoc -> Compiler (Item Pandoc)
forall a b. (a -> b) -> a -> b
$ (String -> Pandoc) -> Item String -> Item Pandoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pandoc -> String -> Pandoc
forall a b. a -> b -> a
const Pandoc
pandoc') Item String
item

--------------------------------------------------------------------------------
pandocBiblioCompiler :: String -> String -> Compiler (Item String)
pandocBiblioCompiler :: String -> String -> Compiler (Item String)
pandocBiblioCompiler cslFileName :: String
cslFileName bibFileName :: String
bibFileName = do
    Item CSL
csl <- Identifier -> Compiler (Item CSL)
forall a. (Binary a, Typeable a) => Identifier -> Compiler (Item a)
load (Identifier -> Compiler (Item CSL))
-> Identifier -> Compiler (Item CSL)
forall a b. (a -> b) -> a -> b
$ String -> Identifier
fromFilePath String
cslFileName
    Item Biblio
bib <- Identifier -> Compiler (Item Biblio)
forall a. (Binary a, Typeable a) => Identifier -> Compiler (Item a)
load (Identifier -> Compiler (Item Biblio))
-> Identifier -> Compiler (Item Biblio)
forall a b. (a -> b) -> a -> b
$ String -> Identifier
fromFilePath String
bibFileName
    (Item Pandoc -> Item String)
-> Compiler (Item Pandoc) -> Compiler (Item String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Item Pandoc -> Item String
writePandoc
        (Compiler (Item String)
getResourceBody Compiler (Item String)
-> (Item String -> Compiler (Item Pandoc))
-> Compiler (Item Pandoc)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderOptions
-> Item CSL -> Item Biblio -> Item String -> Compiler (Item Pandoc)
readPandocBiblio ReaderOptions
ropt Item CSL
csl Item Biblio
bib)
    where ropt :: ReaderOptions
ropt = ReaderOptions
defaultHakyllReaderOptions
            { -- The following option enables citation rendering
              readerExtensions :: Extensions
readerExtensions = Extension -> Extensions -> Extensions
enableExtension Extension
Ext_citations (Extensions -> Extensions) -> Extensions -> Extensions
forall a b. (a -> b) -> a -> b
$ ReaderOptions -> Extensions
readerExtensions ReaderOptions
defaultHakyllReaderOptions
            }