--------------------------------------------------------------------------------
-- | 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. If you already read the
-- source into a 'Pandoc' type and need to add processing for the bibliography,
-- you can use 'processPandocBiblio' instead.
-- 'pandocBiblioCompiler' is a convenience wrapper which works like 'pandocCompiler',
-- but also takes paths to compiled bibliography and csl files;
-- 'pandocBibliosCompiler' is similar but instead takes a glob pattern for bib files.
{-# LANGUAGE Arrows                     #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
module Hakyll.Web.Pandoc.Biblio
    ( CSL (..)
    , cslCompiler
    , Biblio (..)
    , biblioCompiler
    , readPandocBiblio
    , readPandocBiblios
    , processPandocBiblio
    , processPandocBiblios
    , pandocBiblioCompiler
    , pandocBibliosCompiler
    ) where


--------------------------------------------------------------------------------
import           Control.Monad                 (liftM)
import           Data.Binary                   (Binary (..))
import qualified Data.ByteString               as B
import qualified Data.ByteString.Lazy          as BL
import qualified Data.Map                      as Map
import qualified Data.Time                     as Time
import qualified Data.Text                     as T (pack)
import           Data.Typeable                 (Typeable)
import           Hakyll.Core.Compiler
import           Hakyll.Core.Compiler.Internal
import           Hakyll.Core.Identifier
import           Hakyll.Core.Identifier.Pattern (fromGlob)
import           Hakyll.Core.Item
import           Hakyll.Core.Writable
import           Hakyll.Web.Pandoc
import           Text.Pandoc                   (Extension (..), Pandoc,
                                                ReaderOptions (..),
                                                enableExtension)
import qualified Text.Pandoc                   as Pandoc
import qualified Text.Pandoc.Citeproc          as Pandoc (processCitations)
import           System.FilePath               (addExtension, takeExtension)


--------------------------------------------------------------------------------
newtype CSL = CSL {CSL -> ByteString
unCSL :: B.ByteString}
    deriving (Get CSL
[CSL] -> Put
CSL -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [CSL] -> Put
$cputList :: [CSL] -> Put
get :: Get CSL
$cget :: Get CSL
put :: CSL -> Put
$cput :: CSL -> Put
Binary, Int -> CSL -> ShowS
[CSL] -> ShowS
CSL -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CSL] -> ShowS
$cshowList :: [CSL] -> ShowS
show :: CSL -> [Char]
$cshow :: CSL -> [Char]
showsPrec :: Int -> CSL -> ShowS
$cshowsPrec :: Int -> CSL -> ShowS
Show, Typeable)



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


--------------------------------------------------------------------------------
cslCompiler :: Compiler (Item CSL)
cslCompiler :: Compiler (Item CSL)
cslCompiler = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> CSL
CSL forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler (Item ByteString)
getResourceLBS


--------------------------------------------------------------------------------
newtype Biblio = Biblio {Biblio -> ByteString
unBiblio :: B.ByteString}
    deriving (Get Biblio
[Biblio] -> Put
Biblio -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Biblio] -> Put
$cputList :: [Biblio] -> Put
get :: Get Biblio
$cget :: Get Biblio
put :: Biblio -> Put
$cput :: Biblio -> Put
Binary, Int -> Biblio -> ShowS
[Biblio] -> ShowS
Biblio -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Biblio] -> ShowS
$cshowList :: [Biblio] -> ShowS
show :: Biblio -> [Char]
$cshow :: Biblio -> [Char]
showsPrec :: Int -> Biblio -> ShowS
$cshowsPrec :: Int -> Biblio -> ShowS
Show, Typeable)


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


--------------------------------------------------------------------------------
biblioCompiler :: Compiler (Item Biblio)
biblioCompiler :: Compiler (Item Biblio)
biblioCompiler = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Biblio
Biblio forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler (Item ByteString)
getResourceLBS


--------------------------------------------------------------------------------
readPandocBiblio :: ReaderOptions
                 -> Item CSL
                 -> Item Biblio
                 -> (Item String)
                 -> Compiler (Item Pandoc)
readPandocBiblio :: ReaderOptions
-> Item CSL -> Item Biblio -> Item [Char] -> Compiler (Item Pandoc)
readPandocBiblio ReaderOptions
ropt Item CSL
csl Item Biblio
biblio = ReaderOptions
-> Item CSL
-> [Item Biblio]
-> Item [Char]
-> Compiler (Item Pandoc)
readPandocBiblios ReaderOptions
ropt Item CSL
csl [Item Biblio
biblio]

readPandocBiblios :: ReaderOptions
                  -> Item CSL
                  -> [Item Biblio]
                  -> (Item String)
                  -> Compiler (Item Pandoc)
readPandocBiblios :: ReaderOptions
-> Item CSL
-> [Item Biblio]
-> Item [Char]
-> Compiler (Item Pandoc)
readPandocBiblios ReaderOptions
ropt Item CSL
csl [Item Biblio]
biblios Item [Char]
item = do
  Item Pandoc
pandoc <- ReaderOptions -> Item [Char] -> Compiler (Item Pandoc)
readPandocWith ReaderOptions
ropt Item [Char]
item
  Item CSL -> [Item Biblio] -> Item Pandoc -> Compiler (Item Pandoc)
processPandocBiblios Item CSL
csl [Item Biblio]
biblios Item Pandoc
pandoc


--------------------------------------------------------------------------------
processPandocBiblio :: Item CSL
                    -> Item Biblio
                    -> (Item Pandoc)
                    -> Compiler (Item Pandoc)
processPandocBiblio :: Item CSL -> Item Biblio -> Item Pandoc -> Compiler (Item Pandoc)
processPandocBiblio Item CSL
csl Item Biblio
biblio = Item CSL -> [Item Biblio] -> Item Pandoc -> Compiler (Item Pandoc)
processPandocBiblios Item CSL
csl [Item Biblio
biblio]

processPandocBiblios :: Item CSL
                     -> [Item Biblio]
                     -> (Item Pandoc)
                     -> Compiler (Item Pandoc)
processPandocBiblios :: Item CSL -> [Item Biblio] -> Item Pandoc -> Compiler (Item Pandoc)
processPandocBiblios Item CSL
csl [Item Biblio]
biblios Item Pandoc
item = do
    -- It's not straightforward to use the Pandoc API as of 2.11 to deal with
    -- citations, since it doesn't export many things in 'Text.Pandoc.Citeproc'.
    -- The 'citeproc' package is also hard to use.
    --
    -- So instead, we try treating Pandoc as a black box.  Pandoc can read
    -- specific csl and bilbio files based on metadata keys.
    --
    -- So we load the CSL and Biblio files and pass them to Pandoc using the
    -- ersatz filesystem.
    let Pandoc.Pandoc (Pandoc.Meta Map Text MetaValue
meta) [Block]
blocks = forall a. Item a -> a
itemBody Item Pandoc
item
        cslFile :: FileInfo
cslFile = UTCTime -> ByteString -> FileInfo
Pandoc.FileInfo UTCTime
zeroTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSL -> ByteString
unCSL forall a b. (a -> b) -> a -> b
$ forall a. Item a -> a
itemBody Item CSL
csl
        bibFiles :: [([Char], FileInfo)]
bibFiles = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
x Item Biblio
y ->
            ( [Char] -> ShowS
addExtension ([Char]
"_hakyll/bibliography-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Integer
x)
                           (ShowS
takeExtension forall a b. (a -> b) -> a -> b
$ Identifier -> [Char]
toFilePath forall a b. (a -> b) -> a -> b
$ forall a. Item a -> Identifier
itemIdentifier Item Biblio
y)
            , UTCTime -> ByteString -> FileInfo
Pandoc.FileInfo UTCTime
zeroTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Biblio -> ByteString
unBiblio forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Item a -> a
itemBody forall a b. (a -> b) -> a -> b
$ Item Biblio
y
            )
          )
          [Integer
0 :: Integer ..]
          [Item Biblio]
biblios

        stFiles :: FileTree -> FileTree
stFiles = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> FileInfo -> FileTree -> FileTree
Pandoc.insertInFileTree)
                    ([Char] -> FileInfo -> FileTree -> FileTree
Pandoc.insertInFileTree [Char]
"_hakyll/style.csl" FileInfo
cslFile)
                    [([Char], FileInfo)]
bibFiles

        addBiblioFiles :: PureState -> PureState
addBiblioFiles = \PureState
st -> PureState
st { stFiles :: FileTree
Pandoc.stFiles = FileTree -> FileTree
stFiles forall a b. (a -> b) -> a -> b
$ PureState -> FileTree
Pandoc.stFiles PureState
st }

        biblioMeta :: Meta
biblioMeta = Map Text MetaValue -> Meta
Pandoc.Meta forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"csl" (Text -> MetaValue
Pandoc.MetaString Text
"_hakyll/style.csl") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"bibliography"
              ([MetaValue] -> MetaValue
Pandoc.MetaList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> MetaValue
Pandoc.MetaString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [([Char], FileInfo)]
bibFiles) forall a b. (a -> b) -> a -> b
$
            Map Text MetaValue
meta
        errOrPandoc :: Either PandocError Pandoc
errOrPandoc = forall a. PandocPure a -> Either PandocError a
Pandoc.runPure forall a b. (a -> b) -> a -> b
$ do
            (PureState -> PureState) -> PandocPure ()
Pandoc.modifyPureState PureState -> PureState
addBiblioFiles
            forall (m :: * -> *). PandocMonad m => Pandoc -> m Pandoc
Pandoc.processCitations forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc.Pandoc Meta
biblioMeta [Block]
blocks

    Pandoc
pandoc <- case Either PandocError Pandoc
errOrPandoc of
        Left  PandocError
e -> forall a. [[Char]] -> Compiler a
compilerThrow [[Char]
"Error during processCitations: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PandocError
e]
        Right Pandoc
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
x

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

  where
    zeroTime :: UTCTime
zeroTime = Day -> DiffTime -> UTCTime
Time.UTCTime (forall a. Enum a => Int -> a
toEnum Int
0) DiffTime
0


--------------------------------------------------------------------------------
-- | Compiles a markdown file via Pandoc. Requires the .csl and .bib files to be known to the compiler via match statements.
pandocBiblioCompiler :: String -> String -> Compiler (Item String)
pandocBiblioCompiler :: [Char] -> [Char] -> Compiler (Item [Char])
pandocBiblioCompiler [Char]
cslFileName [Char]
bibFileName = do
    Item CSL
csl <- forall a. (Binary a, Typeable a) => Identifier -> Compiler (Item a)
load forall a b. (a -> b) -> a -> b
$ [Char] -> Identifier
fromFilePath [Char]
cslFileName
    Item Biblio
bib <- forall a. (Binary a, Typeable a) => Identifier -> Compiler (Item a)
load forall a b. (a -> b) -> a -> b
$ [Char] -> Identifier
fromFilePath [Char]
bibFileName
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Item Pandoc -> Item [Char]
writePandoc
        (Compiler (Item [Char])
getResourceBody forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderOptions
-> Item CSL -> Item Biblio -> Item [Char] -> 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 forall a b. (a -> b) -> a -> b
$ ReaderOptions -> Extensions
readerExtensions ReaderOptions
defaultHakyllReaderOptions
            }

--------------------------------------------------------------------------------
-- | Compiles a markdown file via Pandoc. Requires the .csl and .bib files to be known to the compiler via match statements.
pandocBibliosCompiler :: String -> String -> Compiler (Item String)
pandocBibliosCompiler :: [Char] -> [Char] -> Compiler (Item [Char])
pandocBibliosCompiler [Char]
cslFileName [Char]
bibFileName = do
    Item CSL
csl  <- forall a. (Binary a, Typeable a) => Identifier -> Compiler (Item a)
load    forall a b. (a -> b) -> a -> b
$ [Char] -> Identifier
fromFilePath [Char]
cslFileName
    [Item Biblio]
bibs <- forall a. (Binary a, Typeable a) => Pattern -> Compiler [Item a]
loadAll forall a b. (a -> b) -> a -> b
$ [Char] -> Pattern
fromGlob [Char]
bibFileName
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Item Pandoc -> Item [Char]
writePandoc
        (Compiler (Item [Char])
getResourceBody forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderOptions
-> Item CSL
-> [Item Biblio]
-> Item [Char]
-> Compiler (Item Pandoc)
readPandocBiblios ReaderOptions
ropt Item CSL
csl [Item Biblio]
bibs)
    where ropt :: ReaderOptions
ropt = ReaderOptions
defaultHakyllReaderOptions
            { -- The following option enables citation rendering
              readerExtensions :: Extensions
readerExtensions = Extension -> Extensions -> Extensions
enableExtension Extension
Ext_citations forall a b. (a -> b) -> a -> b
$ ReaderOptions -> Extensions
readerExtensions ReaderOptions
defaultHakyllReaderOptions
            }