From 88519fef556deee41a30550420243fc3ca86606b Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <m@jaspervdj.be>
Date: Tue, 22 Nov 2011 08:39:44 +0100
Subject: Fix bibliography handling

---
 src/Hakyll/Web/Pandoc.hs        | 16 +++++++++---
 src/Hakyll/Web/Pandoc/Biblio.hs | 56 ++++++++++++++++++++++++++---------------
 2 files changed, 48 insertions(+), 24 deletions(-)

(limited to 'src/Hakyll/Web')

diff --git a/src/Hakyll/Web/Pandoc.hs b/src/Hakyll/Web/Pandoc.hs
index a1bd09c..be6b544 100644
--- a/src/Hakyll/Web/Pandoc.hs
+++ b/src/Hakyll/Web/Pandoc.hs
@@ -10,6 +10,7 @@ module Hakyll.Web.Pandoc
       -- * Functions working on pages/compilers
     , pageReadPandoc
     , pageReadPandocWith
+    , pageReadPandocWithA
     , pageRenderPandoc
     , pageRenderPandocWith
 
@@ -20,7 +21,7 @@ module Hakyll.Web.Pandoc
 
 import Prelude hiding (id)
 import Control.Applicative ((<$>))
-import Control.Arrow ((>>^), (&&&))
+import Control.Arrow ((>>>), (>>^), (&&&), (***))
 import Control.Category (id)
 import Data.Maybe (fromMaybe)
 
@@ -28,6 +29,7 @@ import Text.Pandoc
 
 import Hakyll.Core.Compiler
 import Hakyll.Core.Identifier
+import Hakyll.Core.Util.Arrow
 import Hakyll.Web.Pandoc.FileType
 import Hakyll.Web.Page.Internal
 
@@ -78,10 +80,16 @@ pageReadPandoc = pageReadPandocWith defaultHakyllParserState
 -- | Read the resource using pandoc
 --
 pageReadPandocWith :: ParserState -> Compiler (Page String) (Page Pandoc)
-pageReadPandocWith state =
-    id &&& getIdentifier &&& getFileType >>^ pageReadPandocWith'
+pageReadPandocWith state = constA state &&& id >>> pageReadPandocWithA
+
+-- | Read the resource using pandoc. This is a (rarely needed) variant, which
+-- comes in very useful when the parser state is the result of some arrow.
+--
+pageReadPandocWithA :: Compiler (ParserState, Page String) (Page Pandoc)
+pageReadPandocWithA =
+    id *** id &&& getIdentifier &&& getFileType >>^ pageReadPandocWithA'
   where
-    pageReadPandocWith' (p, (i, t)) = readPandocWith state t (Just i) <$> p
+    pageReadPandocWithA' (s, (p, (i, t))) = readPandocWith s t (Just i) <$> p
 
 -- | Render the resource using pandoc
 --
diff --git a/src/Hakyll/Web/Pandoc/Biblio.hs b/src/Hakyll/Web/Pandoc/Biblio.hs
index 6cc9f83..681d40a 100644
--- a/src/Hakyll/Web/Pandoc/Biblio.hs
+++ b/src/Hakyll/Web/Pandoc/Biblio.hs
@@ -1,11 +1,19 @@
 -- | 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 'pageReadPandocBiblio'. This function also
+-- takes a parser state for completeness -- you can use
+-- 'defaultHakyllParserState' if you're unsure.
+--
 {-# LANGUAGE Arrows, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
 module Hakyll.Web.Pandoc.Biblio
     ( CSL
     , cslCompiler
-    , References (..)
-    , referencesCompiler
-    , processBiblioCompiler
+    , Biblio (..)
+    , biblioCompiler
+    , pageReadPandocBiblio
     ) where
 
 import Control.Applicative ((<$>))
@@ -13,7 +21,7 @@ import Control.Arrow (arr, returnA)
 import Data.Typeable (Typeable)
 
 import Data.Binary (Binary (..))
-import Text.Pandoc (Pandoc)
+import Text.Pandoc (Pandoc, ParserState (..))
 import Text.Pandoc.Biblio (processBiblio)
 import qualified Text.CSL as CSL
 
@@ -22,6 +30,7 @@ import Hakyll.Core.Identifier
 import Hakyll.Core.Resource
 import Hakyll.Core.Writable
 import Hakyll.Web.Page
+import Hakyll.Web.Pandoc
 
 newtype CSL = CSL FilePath
     deriving (Binary, Show, Typeable, Writable)
@@ -29,29 +38,36 @@ newtype CSL = CSL FilePath
 cslCompiler :: Compiler Resource CSL
 cslCompiler = arr (CSL . unResource)
 
-newtype References = References [CSL.Reference]
+newtype Biblio = Biblio [CSL.Reference]
     deriving (Show, Typeable)
 
-instance Binary References where
+instance Binary Biblio where
     -- Ugly.
-    get                 = References . read <$> get
-    put (References rs) = put $ show rs
+    get             = Biblio . read <$> get
+    put (Biblio rs) = put $ show rs
 
-instance Writable References where
+instance Writable Biblio where
     write _ _ = return ()
 
-referencesCompiler :: Compiler Resource References
-referencesCompiler = unsafeCompiler $
-    fmap References . CSL.readBiblioFile . unResource
+biblioCompiler :: Compiler Resource Biblio
+biblioCompiler = unsafeCompiler $
+    fmap Biblio . CSL.readBiblioFile . unResource
 
-processBiblioCompiler :: Identifier CSL
-                      -> Identifier References
-                      -> Compiler (Page Pandoc) (Page Pandoc)
-processBiblioCompiler csl refs = proc page -> do
-    let body = pageBody page
+pageReadPandocBiblio :: ParserState
+                     -> Identifier CSL
+                     -> Identifier Biblio
+                     -> Compiler (Page String) (Page Pandoc)
+pageReadPandocBiblio state csl refs = proc page -> do
     CSL csl' <- require_ csl -< ()
-    References refs' <- require_ refs -< ()
-    body' <- unsafeCompiler (tuc processBiblio) -< (csl', refs', body)
-    returnA -< page {pageBody = body'}
+    Biblio refs' <- require_ refs -< ()
+    -- 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 cits   = map CSL.refId refs'
+        state' = state {stateCitations = stateCitations state ++ cits}
+    pandocPage <- pageReadPandocWithA -< (state', page)
+    let pandoc = pageBody pandocPage
+    pandoc' <- unsafeCompiler (tuc processBiblio) -< (csl', refs', pandoc)
+    returnA -< pandocPage {pageBody = pandoc'}
   where
     tuc f (x, y, z) = f x y z
-- 
cgit v1.2.3