{-# 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
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
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
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
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
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
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
{
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
}