    --------------------------------------------------------------------------------
    -- | 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
    (CSL -> Put) -> Get CSL -> ([CSL] -> Put) -> Binary CSL
    forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
    $cput :: CSL -> Put
    put :: CSL -> Put
    $cget :: Get CSL
    get :: Get CSL
    $cputList :: [CSL] -> Put
    putList :: [CSL] -> Put
    Binary, Int -> CSL -> ShowS
    [CSL] -> ShowS
    CSL -> [Char]
    (Int -> CSL -> ShowS)
    -> (CSL -> [Char]) -> ([CSL] -> ShowS) -> Show CSL
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CSL -> ShowS
    showsPrec :: Int -> CSL -> ShowS
    $cshow :: CSL -> [Char]
    show :: CSL -> [Char]
    $cshowList :: [CSL] -> ShowS
    showList :: [CSL] -> ShowS
    Show, Typeable)

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

    --------------------------------------------------------------------------------
    cslCompiler :: Compiler (Item CSL)
    cslCompiler :: Compiler (Item CSL)
    cslCompiler = (ByteString -> CSL) -> Item ByteString -> Item CSL
    forall a b. (a -> b) -> Item a -> Item b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ByteString -> CSL
    CSL (ByteString -> CSL)
    -> (ByteString -> ByteString) -> ByteString -> CSL
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.toStrict) (Item ByteString -> Item CSL)
    -> Compiler (Item ByteString) -> Compiler (Item CSL)
    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
    (Biblio -> Put) -> Get Biblio -> ([Biblio] -> Put) -> Binary Biblio
    forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
    $cput :: Biblio -> Put
    put :: Biblio -> Put
    $cget :: Get Biblio
    get :: Get Biblio
    $cputList :: [Biblio] -> Put
    putList :: [Biblio] -> Put
    Binary, Int -> Biblio -> ShowS
    [Biblio] -> ShowS
    Biblio -> [Char]
    (Int -> Biblio -> ShowS)
    -> (Biblio -> [Char]) -> ([Biblio] -> ShowS) -> Show Biblio
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Biblio -> ShowS
    showsPrec :: Int -> Biblio -> ShowS
    $cshow :: Biblio -> [Char]
    show :: Biblio -> [Char]
    $cshowList :: [Biblio] -> ShowS
    showList :: [Biblio] -> ShowS
    Show, Typeable)

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

    --------------------------------------------------------------------------------
    biblioCompiler :: Compiler (Item Biblio)
    biblioCompiler :: Compiler (Item Biblio)
    biblioCompiler = (ByteString -> Biblio) -> Item ByteString -> Item Biblio
    forall a b. (a -> b) -> Item a -> Item b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ByteString -> Biblio
    Biblio (ByteString -> Biblio)
    -> (ByteString -> ByteString) -> ByteString -> Biblio
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.toStrict) (Item ByteString -> Item Biblio)
    -> Compiler (Item ByteString) -> Compiler (Item Biblio)
    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 = Item Pandoc -> Pandoc
    forall a. Item a -> a
    itemBody Item Pandoc
    item
            cslFile :: FileInfo
    cslFile = UTCTime -> ByteString -> FileInfo
    Pandoc.FileInfo UTCTime
    zeroTime (ByteString -> FileInfo) -> (CSL -> ByteString) -> CSL -> FileInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CSL -> ByteString
    unCSL (CSL -> FileInfo) -> CSL -> FileInfo
    forall a b. (a -> b) -> a -> b
    $ Item CSL -> CSL
    forall a. Item a -> a
    itemBody Item CSL
    csl
            bibFiles :: [([Char], FileInfo)]
    bibFiles = (Integer -> Item Biblio -> ([Char], FileInfo))
    -> [Integer] -> [Item Biblio] -> [([Char], FileInfo)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Integer
    x Item Biblio
    y ->
                ( [Char] -> ShowS
    addExtension ([Char]
    "_hakyll/bibliography-" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Integer -> [Char]
    forall a. Show a => a -> [Char]
    show Integer
    x)
                               (ShowS
    takeExtension ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Identifier -> [Char]
    toFilePath (Identifier -> [Char]) -> Identifier -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Item Biblio -> Identifier
    forall a. Item a -> Identifier
    itemIdentifier Item Biblio
    y)
                , UTCTime -> ByteString -> FileInfo
    Pandoc.FileInfo UTCTime
    zeroTime (ByteString -> FileInfo)
    -> (Item Biblio -> ByteString) -> Item Biblio -> FileInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Biblio -> ByteString
    unBiblio (Biblio -> ByteString)
    -> (Item Biblio -> Biblio) -> Item Biblio -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Item Biblio -> Biblio
    forall a. Item a -> a
    itemBody (Item Biblio -> FileInfo) -> Item Biblio -> FileInfo
    forall a b. (a -> b) -> a -> b
    $ Item Biblio
    y
                )
              )
              [Integer
    0 :: Integer ..]
              [Item Biblio]
    biblios

            stFiles :: FileTree -> FileTree
    stFiles = (([Char], FileInfo)
     -> (FileTree -> FileTree) -> FileTree -> FileTree)
    -> (FileTree -> FileTree)
    -> [([Char], FileInfo)]
    -> FileTree
    -> FileTree
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((FileTree -> FileTree)
    -> (FileTree -> FileTree) -> FileTree -> FileTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ((FileTree -> FileTree)
     -> (FileTree -> FileTree) -> FileTree -> FileTree)
    -> (([Char], FileInfo) -> FileTree -> FileTree)
    -> ([Char], FileInfo)
    -> (FileTree -> FileTree)
    -> FileTree
    -> FileTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char] -> FileInfo -> FileTree -> FileTree)
    -> ([Char], FileInfo) -> FileTree -> FileTree
    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 { Pandoc.stFiles = stFiles $ Pandoc.stFiles st }

            biblioMeta :: Meta
    biblioMeta = Map Text MetaValue -> Meta
    Pandoc.Meta (Map Text MetaValue -> Meta)
    -> (Map Text MetaValue -> Map Text MetaValue)
    -> Map Text MetaValue
    -> Meta
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
    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") (Map Text MetaValue -> Map Text MetaValue)
    -> (Map Text MetaValue -> Map Text MetaValue)
    -> Map Text MetaValue
    -> Map Text MetaValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert Text
    "bibliography"
                  ([MetaValue] -> MetaValue
    Pandoc.MetaList ([MetaValue] -> MetaValue) -> [MetaValue] -> MetaValue
    forall a b. (a -> b) -> a -> b
    $ (([Char], FileInfo) -> MetaValue)
    -> [([Char], FileInfo)] -> [MetaValue]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> MetaValue
    Pandoc.MetaString (Text -> MetaValue)
    -> (([Char], FileInfo) -> Text) -> ([Char], FileInfo) -> MetaValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Text
    T.pack ([Char] -> Text)
    -> (([Char], FileInfo) -> [Char]) -> ([Char], FileInfo) -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char], FileInfo) -> [Char]
    forall a b. (a, b) -> a
    fst) [([Char], FileInfo)]
    bibFiles) (Map Text MetaValue -> Meta) -> Map Text MetaValue -> Meta
    forall a b. (a -> b) -> a -> b
    $
                Map Text MetaValue
    meta
            errOrPandoc :: Either PandocError Pandoc
    errOrPandoc = PandocPure Pandoc -> Either PandocError Pandoc
    forall a. PandocPure a -> Either PandocError a
    Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
    -> PandocPure Pandoc -> Either PandocError Pandoc
    forall a b. (a -> b) -> a -> b
    $ do
                (PureState -> PureState) -> PandocPure ()
    Pandoc.modifyPureState PureState -> PureState
    addBiblioFiles
                Pandoc -> PandocPure Pandoc
    forall (m :: * -> *). PandocMonad m => Pandoc -> m Pandoc
    Pandoc.processCitations (Pandoc -> PandocPure Pandoc) -> Pandoc -> PandocPure Pandoc
    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 -> [[Char]] -> Compiler Pandoc
    forall a. [[Char]] -> Compiler a
    compilerThrow [[Char]
    "Error during processCitations: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ PandocError -> [Char]
    forall a. Show a => a -> [Char]
    show PandocError
    e]
            Right Pandoc
    x -> Pandoc -> Compiler Pandoc
    forall a. a -> Compiler a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Pandoc
    x

        Item Pandoc -> Compiler (Item Pandoc)
    forall a. a -> Compiler a
    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
    $ (Pandoc -> Pandoc) -> Item Pandoc -> Item Pandoc
    forall a b. (a -> b) -> Item a -> Item b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Pandoc -> Pandoc -> Pandoc
    forall a b. a -> b -> a
    const Pandoc
    pandoc) Item Pandoc
    item

      where
        zeroTime :: UTCTime
    zeroTime = Day -> DiffTime -> UTCTime
    Time.UTCTime (Int -> Day
    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 <- 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
    $ [Char] -> Identifier
    fromFilePath [Char]
    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
    $ [Char] -> Identifier
    fromFilePath [Char]
    bibFileName
        (Item Pandoc -> Item [Char])
    -> Compiler (Item Pandoc) -> Compiler (Item [Char])
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Item Pandoc -> Item [Char]
    writePandoc
            (Compiler (Item [Char])
    getResourceBody Compiler (Item [Char])
    -> (Item [Char] -> Compiler (Item Pandoc))
    -> Compiler (Item Pandoc)
    forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
    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 = enableExtension Ext_citations $ readerExtensions 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  <- 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
    $ [Char] -> Identifier
    fromFilePath [Char]
    cslFileName
        [Item Biblio]
    bibs <- Pattern -> Compiler [Item Biblio]
    forall a. (Binary a, Typeable a) => Pattern -> Compiler [Item a]
    loadAll (Pattern -> Compiler [Item Biblio])
    -> Pattern -> Compiler [Item Biblio]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Pattern
    fromGlob [Char]
    bibFileName
        (Item Pandoc -> Item [Char])
    -> Compiler (Item Pandoc) -> Compiler (Item [Char])
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Item Pandoc -> Item [Char]
    writePandoc
            (Compiler (Item [Char])
    getResourceBody Compiler (Item [Char])
    -> (Item [Char] -> Compiler (Item Pandoc))
    -> Compiler (Item Pandoc)
    forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
    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 = enableExtension Ext_citations $ readerExtensions defaultHakyllReaderOptions
                }