{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleContexts  #-}

-- | <https://ctan.org/tex-archive/macros/latex/contrib/biblatex BibLaTeX>
--   is a reference-citation package using @.bib@ files (BibTeX) but no extra style-files.
--
module Text.LaTeX.Packages.BibLaTeX
 ( biblatex
 , addbibresource
 , cite
 , printbibliography
 -- * Automatic bibliography retrieval
 , documentWithDOIReferences
 , PlainDOI
 , citeDOI
 , textc
 , textC
 , DOIReference
 , ReferenceQueryT
 , masterBibFile
 ) where

import Text.LaTeX.Base.Syntax hiding ((<>))
import Text.LaTeX.Base.Class (LaTeXC(..), liftL, fromLaTeX, comm0, raw)
import Text.LaTeX.Base.Render
import Text.LaTeX.Base.Types
import Text.LaTeX.Base.Commands (cite, footnote, document)

import Data.Char (toLower)
import qualified Data.Semigroup as SG
import GHC.Generics (Generic)
import qualified Data.Traversable as Tr

import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import Data.Hashable (hash)
import Numeric (showHex)

import qualified Data.List as List

import Control.Applicative
import Control.Monad (forM)
import Control.Monad.IO.Class

import qualified Text.BibTeX.Entry as BibTeX
import qualified Text.BibTeX.Format as BibTeX
import qualified Text.BibTeX.Parse as BibTeX (file)
import qualified Text.Parsec.String as Parsec

-- | BibLaTeX package. Use it to import it like this:
--
-- > usepackage [] biblatex
biblatex :: PackageName
biblatex :: PackageName
biblatex = PackageName
"biblatex"

-- | Use a bibliography file as resource for reference information.
addbibresource :: LaTeXC l => FilePath -> l
addbibresource :: PackageName -> l
addbibresource PackageName
fp = LaTeX -> l
forall l. LaTeXC l => LaTeX -> l
fromLaTeX (LaTeX -> l) -> LaTeX -> l
forall a b. (a -> b) -> a -> b
$ PackageName -> [TeXArg] -> LaTeX
TeXComm PackageName
"addbibresource" [LaTeX -> TeXArg
FixArg (LaTeX -> TeXArg) -> LaTeX -> TeXArg
forall a b. (a -> b) -> a -> b
$ Text -> LaTeX
TeXRaw (Text -> LaTeX) -> Text -> LaTeX
forall a b. (a -> b) -> a -> b
$ PackageName -> Text
forall a. IsString a => PackageName -> a
fromString PackageName
fp]

printbibliography :: LaTeXC l => l
printbibliography :: l
printbibliography = PackageName -> l
forall l. LaTeXC l => PackageName -> l
comm0 PackageName
"printbibliography"


documentWithDOIReferences :: (MonadIO m, LaTeXC (m ()), SG.Semigroup (m ()), r ~ DOIReference)
  => (r -> m (Maybe BibTeX.T)) -- ^ Reference-resolver function, for looking up BibTeX
                               --   entries for a given DOI.
                               --   If the DOI cannot be looked up (@Nothing@), we just
                               --   include a footnote with a synopsis and the DOI in
                               --   literal form. (Mostly intended to ease offline editing.)
  -> ReferenceQueryT r m ()    -- ^ The document content, possibly containing citations
                               --   in DOI-only form.
  -> m ()                      -- ^ LaTeX rendition. The content will already be wrapped
                               --   in @\\begin…end{document}@ here and an
                               --   automatically-generated @.bib@ file included, but
                               --   you still need to 'usepackage' 'biblatex' yourself.
documentWithDOIReferences :: (r -> m (Maybe T)) -> ReferenceQueryT r m () -> m ()
documentWithDOIReferences r -> m (Maybe T)
resolver (ReferenceQueryT m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
refq) = do
    (DList r
allRefs, (), (r -> CitationFlavour -> m ()) -> m ()
useRefs) <- m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
refq
    [(r, T)]
resolved <- ([Maybe (r, T)] -> [(r, T)]) -> m [Maybe (r, T)] -> m [(r, T)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (r, T)] -> [(r, T)]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe (r, T)] -> m [(r, T)])
-> ((r -> m (Maybe (r, T))) -> m [Maybe (r, T)])
-> (r -> m (Maybe (r, T)))
-> m [(r, T)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [r] -> (r -> m (Maybe (r, T))) -> m [Maybe (r, T)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (DList r
allRefs[]) ((r -> m (Maybe (r, T))) -> m [(r, T)])
-> (r -> m (Maybe (r, T))) -> m [(r, T)]
forall a b. (a -> b) -> a -> b
$ \r
r -> do
       Maybe T
r' <- r -> m (Maybe T)
resolver r
r
       Maybe (r, T) -> m (Maybe (r, T))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (r, T) -> m (Maybe (r, T)))
-> Maybe (r, T) -> m (Maybe (r, T))
forall a b. (a -> b) -> a -> b
$ case Maybe T
r' of
         Just T
entry -> (r, T) -> Maybe (r, T)
forall a. a -> Maybe a
Just (r
r, T
entry)
         Maybe T
Nothing -> Maybe (r, T)
forall a. Maybe a
Nothing
    let refsMap :: Map r T
refsMap = [(r, T)] -> Map r T
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(r, T)]
resolved
        bibfileConts :: PackageName
bibfileConts = [PackageName] -> PackageName
unlines ([PackageName] -> PackageName) -> [PackageName] -> PackageName
forall a b. (a -> b) -> a -> b
$ T -> PackageName
BibTeX.entry (T -> PackageName) -> ((r, T) -> T) -> (r, T) -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r, T) -> T
forall a b. (a, b) -> b
snd ((r, T) -> PackageName) -> [(r, T)] -> [PackageName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map r T -> [(r, T)]
forall k a. Map k a -> [(k, a)]
Map.toList Map r T
refsMap
        bibfileName :: PackageName
bibfileName = Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ PackageName -> Int
forall a. Hashable a => a -> Int
hash PackageName
bibfileConts) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PackageName
".bib"
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PackageName -> PackageName -> IO ()
writeFile PackageName
bibfileName PackageName
bibfileConts
    () <- PackageName -> m ()
forall l. LaTeXC l => PackageName -> l
addbibresource PackageName
bibfileName
    m () -> m ()
forall l. LaTeXC l => l -> l
document (m () -> m ())
-> ((r -> CitationFlavour -> m ()) -> m ())
-> (r -> CitationFlavour -> m ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> CitationFlavour -> m ()) -> m ()
useRefs ((r -> CitationFlavour -> m ()) -> m ())
-> (r -> CitationFlavour -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \r
r CitationFlavour
flavour -> case r -> Map r T -> Maybe T
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup r
r Map r T
refsMap of
        Just T
a -> let citeC :: m () -> m ()
citeC = (LaTeX -> LaTeX) -> m () -> m ()
forall l. LaTeXC l => (LaTeX -> LaTeX) -> l -> l
liftL ((LaTeX -> LaTeX) -> m () -> m ())
-> (LaTeX -> LaTeX) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ \LaTeX
l -> (PackageName -> [TeXArg] -> LaTeX
`TeXComm`[LaTeX -> TeXArg
FixArg LaTeX
l]) (PackageName -> LaTeX) -> PackageName -> LaTeX
forall a b. (a -> b) -> a -> b
$ case CitationFlavour
flavour of
                        CitationFlavour
Flavour_cite      -> PackageName
"cite" 
                        CitationFlavour
Flavour_Cite      -> PackageName
"Cite"
                        CitationFlavour
Flavour_parencite -> PackageName
"parencite"
                        CitationFlavour
Flavour_Parencite -> PackageName
"Parencite"
                        CitationFlavour
Flavour_footcite  -> PackageName
"footcite"
                        CitationFlavour
Flavour_Footcite  -> PackageName
"Footcite"
                        CitationFlavour
Flavour_textcite  -> PackageName
"textcite"
                        CitationFlavour
Flavour_Textcite  -> PackageName
"Textcite"
                        CitationFlavour
Flavour_smartcite -> PackageName
"smartcite"
                        CitationFlavour
Flavour_Smartcite -> PackageName
"Smartcite"
                  in m () -> m ()
citeC (m () -> m ()) -> (PackageName -> m ()) -> PackageName -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
forall l. LaTeXC l => Text -> l
raw (Text -> m ()) -> (PackageName -> Text) -> PackageName -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Text
forall a. IsString a => PackageName -> a
fromString (PackageName -> m ()) -> PackageName -> m ()
forall a b. (a -> b) -> a -> b
$ T -> PackageName
BibTeX.identifier T
a
        Maybe T
Nothing -> DOIReference -> m ()
forall l. (LaTeXC l, Semigroup l) => DOIReference -> l
makeshift r
DOIReference
r
 where makeshift :: (LaTeXC l, SG.Semigroup l) => DOIReference -> l
       makeshift :: DOIReference -> l
makeshift (DOIReference PackageName
doi LaTeX
synops) = l -> l
forall l. LaTeXC l => l -> l
footnote (l -> l) -> l -> l
forall a b. (a -> b) -> a -> b
$
           LaTeX -> l
forall l. LaTeXC l => LaTeX -> l
fromLaTeX LaTeX
synops l -> l -> l
forall a. Semigroup a => a -> a -> a
SG.<> l
". DOI:" l -> l -> l
forall a. Semigroup a => a -> a -> a
SG.<> PackageName -> l
forall a. IsString a => PackageName -> a
fromString PackageName
doi
    

type PlainDOI = String

data DOIReference = DOIReference {
       DOIReference -> PackageName
_referenceDOI :: PlainDOI
     , DOIReference -> LaTeX
_referenceSynopsis :: LaTeX
     } deriving ((forall x. DOIReference -> Rep DOIReference x)
-> (forall x. Rep DOIReference x -> DOIReference)
-> Generic DOIReference
forall x. Rep DOIReference x -> DOIReference
forall x. DOIReference -> Rep DOIReference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DOIReference x -> DOIReference
$cfrom :: forall x. DOIReference -> Rep DOIReference x
Generic)
instance Eq DOIReference where
  DOIReference PackageName
doi₀ LaTeX
_ == :: DOIReference -> DOIReference -> Bool
== DOIReference PackageName
doi₁ LaTeX
_ = PackageName
doi₀ PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
doi₁
instance Ord DOIReference where
  compare :: DOIReference -> DOIReference -> Ordering
compare (DOIReference PackageName
doi₀ LaTeX
_) (DOIReference PackageName
doi₁ LaTeX
_) = PackageName -> PackageName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare PackageName
doi₀ PackageName
doi₁

type DList r = [r] -> [r]

data CitationFlavour
       = Flavour_cite
       | Flavour_Cite
       | Flavour_parencite
       | Flavour_Parencite
       | Flavour_footcite
       | Flavour_Footcite
       | Flavour_textcite
       | Flavour_Textcite
       | Flavour_smartcite
       | Flavour_Smartcite
     deriving (CitationFlavour -> CitationFlavour -> Bool
(CitationFlavour -> CitationFlavour -> Bool)
-> (CitationFlavour -> CitationFlavour -> Bool)
-> Eq CitationFlavour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CitationFlavour -> CitationFlavour -> Bool
$c/= :: CitationFlavour -> CitationFlavour -> Bool
== :: CitationFlavour -> CitationFlavour -> Bool
$c== :: CitationFlavour -> CitationFlavour -> Bool
Eq, Eq CitationFlavour
Eq CitationFlavour
-> (CitationFlavour -> CitationFlavour -> Ordering)
-> (CitationFlavour -> CitationFlavour -> Bool)
-> (CitationFlavour -> CitationFlavour -> Bool)
-> (CitationFlavour -> CitationFlavour -> Bool)
-> (CitationFlavour -> CitationFlavour -> Bool)
-> (CitationFlavour -> CitationFlavour -> CitationFlavour)
-> (CitationFlavour -> CitationFlavour -> CitationFlavour)
-> Ord CitationFlavour
CitationFlavour -> CitationFlavour -> Bool
CitationFlavour -> CitationFlavour -> Ordering
CitationFlavour -> CitationFlavour -> CitationFlavour
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CitationFlavour -> CitationFlavour -> CitationFlavour
$cmin :: CitationFlavour -> CitationFlavour -> CitationFlavour
max :: CitationFlavour -> CitationFlavour -> CitationFlavour
$cmax :: CitationFlavour -> CitationFlavour -> CitationFlavour
>= :: CitationFlavour -> CitationFlavour -> Bool
$c>= :: CitationFlavour -> CitationFlavour -> Bool
> :: CitationFlavour -> CitationFlavour -> Bool
$c> :: CitationFlavour -> CitationFlavour -> Bool
<= :: CitationFlavour -> CitationFlavour -> Bool
$c<= :: CitationFlavour -> CitationFlavour -> Bool
< :: CitationFlavour -> CitationFlavour -> Bool
$c< :: CitationFlavour -> CitationFlavour -> Bool
compare :: CitationFlavour -> CitationFlavour -> Ordering
$ccompare :: CitationFlavour -> CitationFlavour -> Ordering
$cp1Ord :: Eq CitationFlavour
Ord, Int -> CitationFlavour -> ShowS
[CitationFlavour] -> ShowS
CitationFlavour -> PackageName
(Int -> CitationFlavour -> ShowS)
-> (CitationFlavour -> PackageName)
-> ([CitationFlavour] -> ShowS)
-> Show CitationFlavour
forall a.
(Int -> a -> ShowS)
-> (a -> PackageName) -> ([a] -> ShowS) -> Show a
showList :: [CitationFlavour] -> ShowS
$cshowList :: [CitationFlavour] -> ShowS
show :: CitationFlavour -> PackageName
$cshow :: CitationFlavour -> PackageName
showsPrec :: Int -> CitationFlavour -> ShowS
$cshowsPrec :: Int -> CitationFlavour -> ShowS
Show)

newtype ReferenceQueryT r m a = ReferenceQueryT {
       ReferenceQueryT r m a
-> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
runReferenceQueryT :: m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
     }
  deriving ((forall x. ReferenceQueryT r m a -> Rep (ReferenceQueryT r m a) x)
-> (forall x.
    Rep (ReferenceQueryT r m a) x -> ReferenceQueryT r m a)
-> Generic (ReferenceQueryT r m a)
forall x. Rep (ReferenceQueryT r m a) x -> ReferenceQueryT r m a
forall x. ReferenceQueryT r m a -> Rep (ReferenceQueryT r m a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall r (m :: * -> *) a x.
Rep (ReferenceQueryT r m a) x -> ReferenceQueryT r m a
forall r (m :: * -> *) a x.
ReferenceQueryT r m a -> Rep (ReferenceQueryT r m a) x
$cto :: forall r (m :: * -> *) a x.
Rep (ReferenceQueryT r m a) x -> ReferenceQueryT r m a
$cfrom :: forall r (m :: * -> *) a x.
ReferenceQueryT r m a -> Rep (ReferenceQueryT r m a) x
Generic, a -> ReferenceQueryT r m b -> ReferenceQueryT r m a
(a -> b) -> ReferenceQueryT r m a -> ReferenceQueryT r m b
(forall a b.
 (a -> b) -> ReferenceQueryT r m a -> ReferenceQueryT r m b)
-> (forall a b.
    a -> ReferenceQueryT r m b -> ReferenceQueryT r m a)
-> Functor (ReferenceQueryT r m)
forall a b. a -> ReferenceQueryT r m b -> ReferenceQueryT r m a
forall a b.
(a -> b) -> ReferenceQueryT r m a -> ReferenceQueryT r m b
forall r (m :: * -> *) a b.
Functor m =>
a -> ReferenceQueryT r m b -> ReferenceQueryT r m a
forall r (m :: * -> *) a b.
Functor m =>
(a -> b) -> ReferenceQueryT r m a -> ReferenceQueryT r m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ReferenceQueryT r m b -> ReferenceQueryT r m a
$c<$ :: forall r (m :: * -> *) a b.
Functor m =>
a -> ReferenceQueryT r m b -> ReferenceQueryT r m a
fmap :: (a -> b) -> ReferenceQueryT r m a -> ReferenceQueryT r m b
$cfmap :: forall r (m :: * -> *) a b.
Functor m =>
(a -> b) -> ReferenceQueryT r m a -> ReferenceQueryT r m b
Functor)

instance Applicative m => Applicative (ReferenceQueryT r m) where
  pure :: a -> ReferenceQueryT r m a
pure a
x = m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
forall r (m :: * -> *) a.
m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
ReferenceQueryT (m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
 -> ReferenceQueryT r m a)
-> ((DList r, a, (r -> CitationFlavour -> m ()) -> m ())
    -> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ()))
-> (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DList r, a, (r -> CitationFlavour -> m ()) -> m ())
 -> ReferenceQueryT r m a)
-> (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
forall a b. (a -> b) -> a -> b
$ (DList r
forall a. a -> a
id, a
x, m () -> (r -> CitationFlavour -> m ()) -> m ()
forall a b. a -> b -> a
const (m () -> (r -> CitationFlavour -> m ()) -> m ())
-> m () -> (r -> CitationFlavour -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  ReferenceQueryT m (DList r, a -> b, (r -> CitationFlavour -> m ()) -> m ())
refqf <*> :: ReferenceQueryT r m (a -> b)
-> ReferenceQueryT r m a -> ReferenceQueryT r m b
<*> ReferenceQueryT m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
refqx = m (DList r, b, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m b
forall r (m :: * -> *) a.
m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
ReferenceQueryT (m (DList r, b, (r -> CitationFlavour -> m ()) -> m ())
 -> ReferenceQueryT r m b)
-> m (DList r, b, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m b
forall a b. (a -> b) -> a -> b
$
       ((DList r, a -> b, (r -> CitationFlavour -> m ()) -> m ())
 -> (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
 -> (DList r, b, (r -> CitationFlavour -> m ()) -> m ()))
-> m (DList r, a -> b, (r -> CitationFlavour -> m ()) -> m ())
-> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> m (DList r, b, (r -> CitationFlavour -> m ()) -> m ())
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\(DList r
urefsf, a -> b
f, (r -> CitationFlavour -> m ()) -> m ()
refref)
                (DList r
urefsx, a
x, (r -> CitationFlavour -> m ()) -> m ()
refrex)
                  -> ( DList r
urefsf DList r -> DList r -> DList r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList r
urefsx
                     , a -> b
f a
x
                     , \r -> CitationFlavour -> m ()
resolv -> () -> () -> ()
forall a. Monoid a => a -> a -> a
mappend (() -> () -> ()) -> m () -> m (() -> ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (r -> CitationFlavour -> m ()) -> m ()
refref r -> CitationFlavour -> m ()
resolv m (() -> ()) -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (r -> CitationFlavour -> m ()) -> m ()
refrex r -> CitationFlavour -> m ()
resolv ) )
              m (DList r, a -> b, (r -> CitationFlavour -> m ()) -> m ())
refqf m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
refqx
instance Monad m => Monad (ReferenceQueryT r m) where
  return :: a -> ReferenceQueryT r m a
return = a -> ReferenceQueryT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ReferenceQueryT m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
refsx >>= :: ReferenceQueryT r m a
-> (a -> ReferenceQueryT r m b) -> ReferenceQueryT r m b
>>= a -> ReferenceQueryT r m b
f
     = m (DList r, b, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m b
forall r (m :: * -> *) a.
m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
ReferenceQueryT (m (DList r, b, (r -> CitationFlavour -> m ()) -> m ())
 -> ReferenceQueryT r m b)
-> m (DList r, b, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m b
forall a b. (a -> b) -> a -> b
$ m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
refsx m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ((DList r, a, (r -> CitationFlavour -> m ()) -> m ())
    -> m (DList r, b, (r -> CitationFlavour -> m ()) -> m ()))
-> m (DList r, b, (r -> CitationFlavour -> m ()) -> m ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(DList r
urefsx, a
x, (r -> CitationFlavour -> m ()) -> m ()
refrex)
           -> case a -> ReferenceQueryT r m b
f a
x of
                ReferenceQueryT m (DList r, b, (r -> CitationFlavour -> m ()) -> m ())
refsfx
                  -> (\(DList r
urefsfx,b
fx,(r -> CitationFlavour -> m ()) -> m ()
refrefx)
                        -> ( DList r
urefsxDList r -> DList r -> DList r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.DList r
urefsfx
                           , b
fx
                           , \r -> CitationFlavour -> m ()
resolve -> () -> () -> ()
forall a. Monoid a => a -> a -> a
mappend (() -> () -> ()) -> m () -> m (() -> ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (r -> CitationFlavour -> m ()) -> m ()
refrex r -> CitationFlavour -> m ()
resolve m (() -> ()) -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (r -> CitationFlavour -> m ()) -> m ()
refrefx r -> CitationFlavour -> m ()
resolve ))
                     ((DList r, b, (r -> CitationFlavour -> m ()) -> m ())
 -> (DList r, b, (r -> CitationFlavour -> m ()) -> m ()))
-> m (DList r, b, (r -> CitationFlavour -> m ()) -> m ())
-> m (DList r, b, (r -> CitationFlavour -> m ()) -> m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (DList r, b, (r -> CitationFlavour -> m ()) -> m ())
refsfx
instance MonadIO m => MonadIO (ReferenceQueryT r m) where
  liftIO :: IO a -> ReferenceQueryT r m a
liftIO IO a
a = m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
forall r (m :: * -> *) a.
m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
ReferenceQueryT (m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
 -> ReferenceQueryT r m a)
-> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
forall a b. (a -> b) -> a -> b
$ (\a
r -> (DList r
forall a. a -> a
id, a
r, m () -> (r -> CitationFlavour -> m ()) -> m ()
forall a b. a -> b -> a
const (m () -> (r -> CitationFlavour -> m ()) -> m ())
-> m () -> (r -> CitationFlavour -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) (a -> (DList r, a, (r -> CitationFlavour -> m ()) -> m ()))
-> m a -> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
a

instance (Functor m, Monoid (m a), IsString (m ()), a ~ ())
           => IsString (ReferenceQueryT r m a) where
  fromString :: PackageName -> ReferenceQueryT r m a
fromString PackageName
s = m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
forall r (m :: * -> *) a.
m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
ReferenceQueryT (m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
 -> ReferenceQueryT r m a)
-> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
forall a b. (a -> b) -> a -> b
$ (\a
a -> (DList r
forall a. a -> a
id, a
a, m () -> (r -> CitationFlavour -> m ()) -> m ()
forall a b. a -> b -> a
const (m () -> (r -> CitationFlavour -> m ()) -> m ())
-> m () -> (r -> CitationFlavour -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ PackageName -> m ()
forall a. IsString a => PackageName -> a
fromString PackageName
s)) (a -> (DList r, a, (r -> CitationFlavour -> m ()) -> m ()))
-> m a -> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
forall a. Monoid a => a
mempty

instance (Applicative m, SG.Semigroup (m a), a ~ ())
             => SG.Semigroup (ReferenceQueryT r m a) where
  ReferenceQueryT m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
p <> :: ReferenceQueryT r m a
-> ReferenceQueryT r m a -> ReferenceQueryT r m a
<> ReferenceQueryT m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
q
      = m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m ()
forall r (m :: * -> *) a.
m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
ReferenceQueryT (m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
 -> ReferenceQueryT r m ())
-> m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m ()
forall a b. (a -> b) -> a -> b
$ ((DList r, (), (r -> CitationFlavour -> m ()) -> m ())
 -> (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
 -> (DList r, (), (r -> CitationFlavour -> m ()) -> m ()))
-> m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
-> m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
-> m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\(DList r
rp,(),(r -> CitationFlavour -> m ()) -> m ()
ρp) (DList r
rq,(),(r -> CitationFlavour -> m ()) -> m ()
ρq)
                                     -> (DList r
rpDList r -> DList r -> DList r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.DList r
rq,(),(m () -> m () -> m ())
-> ((r -> CitationFlavour -> m ()) -> m ())
-> ((r -> CitationFlavour -> m ()) -> m ())
-> (r -> CitationFlavour -> m ())
-> m ()
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2((() -> () -> ()) -> m () -> m () -> m ()
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 () -> () -> ()
forall a. Semigroup a => a -> a -> a
(SG.<>))(r -> CitationFlavour -> m ()) -> m ()
ρp (r -> CitationFlavour -> m ()) -> m ()
ρq)) m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
p m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
q

instance (Applicative m, SG.Semigroup (m a), Monoid (m a), a ~ ())
    => Monoid (ReferenceQueryT r m a) where
  mempty :: ReferenceQueryT r m a
mempty = m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
forall r (m :: * -> *) a.
m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
ReferenceQueryT (m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
 -> ReferenceQueryT r m a)
-> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
forall a b. (a -> b) -> a -> b
$ (\a
a -> (DList r
forall a. a -> a
id, a
a, (r -> CitationFlavour -> m ()) -> m ()
forall a. Monoid a => a
mempty)) (a -> (DList r, a, (r -> CitationFlavour -> m ()) -> m ()))
-> m a -> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
forall a. Monoid a => a
mempty
  mappend :: ReferenceQueryT r m a
-> ReferenceQueryT r m a -> ReferenceQueryT r m a
mappend = ReferenceQueryT r m a
-> ReferenceQueryT r m a -> ReferenceQueryT r m a
forall a. Semigroup a => a -> a -> a
(SG.<>)

instance (Applicative m, LaTeXC (m a), SG.Semigroup (m a), a ~ ())
             => LaTeXC (ReferenceQueryT r m a) where
  liftListL :: ([LaTeX] -> LaTeX)
-> [ReferenceQueryT r m a] -> ReferenceQueryT r m a
liftListL [LaTeX] -> LaTeX
f [ReferenceQueryT r m a]
xs = m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m ()
forall r (m :: * -> *) a.
m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
ReferenceQueryT (m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
 -> ReferenceQueryT r m ())
-> m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m ()
forall a b. (a -> b) -> a -> b
$
    (\[(DList r, a, (r -> CitationFlavour -> m ()) -> m ())]
components -> case [(DList r, a, (r -> CitationFlavour -> m ()) -> m ())]
-> ([DList r], [a], [(r -> CitationFlavour -> m ()) -> m ()])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
List.unzip3 [(DList r, a, (r -> CitationFlavour -> m ()) -> m ())]
components of
          ([DList r]
refs, [a]
_, [(r -> CitationFlavour -> m ()) -> m ()]
rebuilds) -> ( (DList r -> DList r -> DList r) -> DList r -> [DList r] -> DList r
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DList r -> DList r -> DList r
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) DList r
forall a. a -> a
id [DList r]
refs
                                 , ()
                                 , \r -> CitationFlavour -> m ()
resolve -> ([LaTeX] -> LaTeX) -> [m ()] -> m ()
forall l. LaTeXC l => ([LaTeX] -> LaTeX) -> [l] -> l
liftListL [LaTeX] -> LaTeX
f ([m ()] -> m ()) -> [m ()] -> m ()
forall a b. (a -> b) -> a -> b
$ (((r -> CitationFlavour -> m ()) -> m ())
-> (r -> CitationFlavour -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ r -> CitationFlavour -> m ()
resolve)(((r -> CitationFlavour -> m ()) -> m ()) -> m ())
-> [(r -> CitationFlavour -> m ()) -> m ()] -> [m ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[(r -> CitationFlavour -> m ()) -> m ()]
rebuilds )
       ) ([(DList r, a, (r -> CitationFlavour -> m ()) -> m ())]
 -> (DList r, (), (r -> CitationFlavour -> m ()) -> m ()))
-> m [(DList r, a, (r -> CitationFlavour -> m ()) -> m ())]
-> m (DList r, (), (r -> CitationFlavour -> m ()) -> m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReferenceQueryT r m a
 -> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ()))
-> [ReferenceQueryT r m a]
-> m [(DList r, a, (r -> CitationFlavour -> m ()) -> m ())]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Tr.traverse ReferenceQueryT r m a
-> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
forall r (m :: * -> *) a.
ReferenceQueryT r m a
-> m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
runReferenceQueryT [ReferenceQueryT r m a]
xs

citeDOI :: (Functor m, Monoid (m ()), IsString (m ()))
        => PlainDOI  -- ^ The unambiguous document identifier.
        -> String    -- ^ Synopsis of the cited work, in the form
                     --   @"J Doe et al 1950: Investigation of a Foo"@;
                     --   this is strictly speaking optional, the synopsis will /not/
                     --   be included in the final document (provided the DOI
                     --   can be properly resolved).
        -> ReferenceQueryT DOIReference m ()
citeDOI :: PackageName -> PackageName -> ReferenceQueryT DOIReference m ()
citeDOI PackageName
doi PackageName
synops = m (DList DOIReference, (),
   (DOIReference -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT DOIReference m ()
forall r (m :: * -> *) a.
m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
ReferenceQueryT (m (DList DOIReference, (),
    (DOIReference -> CitationFlavour -> m ()) -> m ())
 -> ReferenceQueryT DOIReference m ())
-> m (DList DOIReference, (),
      (DOIReference -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT DOIReference m ()
forall a b. (a -> b) -> a -> b
$ (\()
a -> ( (DOIReference
r DOIReference -> DList DOIReference
forall a. a -> [a] -> [a]
:), ()
a, \DOIReference -> CitationFlavour -> m ()
f -> DOIReference -> CitationFlavour -> m ()
f DOIReference
r CitationFlavour
Flavour_cite ))
                       (()
 -> (DList DOIReference, (),
     (DOIReference -> CitationFlavour -> m ()) -> m ()))
-> m ()
-> m (DList DOIReference, (),
      (DOIReference -> CitationFlavour -> m ()) -> m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ()
forall a. Monoid a => a
mempty
 where r :: DOIReference
r = PackageName -> LaTeX -> DOIReference
DOIReference PackageName
doi (LaTeX -> DOIReference) -> LaTeX -> DOIReference
forall a b. (a -> b) -> a -> b
$ PackageName -> LaTeX
forall a. IsString a => PackageName -> a
fromString PackageName
synops

-- | Transform a citation into @\\textcite@, i.e. so that it can be used as a noun in a sentence.
textc :: Functor m => ReferenceQueryT DOIReference m () -> ReferenceQueryT DOIReference m ()
textc :: ReferenceQueryT DOIReference m ()
-> ReferenceQueryT DOIReference m ()
textc (ReferenceQueryT m (DList DOIReference, (),
   (DOIReference -> CitationFlavour -> m ()) -> m ())
y) = m (DList DOIReference, (),
   (DOIReference -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT DOIReference m ()
forall r (m :: * -> *) a.
m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
ReferenceQueryT
        (m (DList DOIReference, (),
    (DOIReference -> CitationFlavour -> m ()) -> m ())
 -> ReferenceQueryT DOIReference m ())
-> m (DList DOIReference, (),
      (DOIReference -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT DOIReference m ()
forall a b. (a -> b) -> a -> b
$ (\(DList DOIReference
r,()
m,(DOIReference -> CitationFlavour -> m ()) -> m ()
a) -> (DList DOIReference
r, ()
m, \DOIReference -> CitationFlavour -> m ()
f -> (DOIReference -> CitationFlavour -> m ()) -> m ()
a (\DOIReference
x CitationFlavour
_ -> DOIReference -> CitationFlavour -> m ()
f DOIReference
x CitationFlavour
Flavour_textcite))) ((DList DOIReference, (),
  (DOIReference -> CitationFlavour -> m ()) -> m ())
 -> (DList DOIReference, (),
     (DOIReference -> CitationFlavour -> m ()) -> m ()))
-> m (DList DOIReference, (),
      (DOIReference -> CitationFlavour -> m ()) -> m ())
-> m (DList DOIReference, (),
      (DOIReference -> CitationFlavour -> m ()) -> m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (DList DOIReference, (),
   (DOIReference -> CitationFlavour -> m ()) -> m ())
y

-- | Transform a citation into @\\Textcite@, i.e. so that it can be used as the first word in a sentence.
textC :: Functor m => ReferenceQueryT DOIReference m () -> ReferenceQueryT DOIReference m ()
textC :: ReferenceQueryT DOIReference m ()
-> ReferenceQueryT DOIReference m ()
textC (ReferenceQueryT m (DList DOIReference, (),
   (DOIReference -> CitationFlavour -> m ()) -> m ())
y) = m (DList DOIReference, (),
   (DOIReference -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT DOIReference m ()
forall r (m :: * -> *) a.
m (DList r, a, (r -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT r m a
ReferenceQueryT
        (m (DList DOIReference, (),
    (DOIReference -> CitationFlavour -> m ()) -> m ())
 -> ReferenceQueryT DOIReference m ())
-> m (DList DOIReference, (),
      (DOIReference -> CitationFlavour -> m ()) -> m ())
-> ReferenceQueryT DOIReference m ()
forall a b. (a -> b) -> a -> b
$ (\(DList DOIReference
r,()
m,(DOIReference -> CitationFlavour -> m ()) -> m ()
a) -> (DList DOIReference
r, ()
m, \DOIReference -> CitationFlavour -> m ()
f -> (DOIReference -> CitationFlavour -> m ()) -> m ()
a (\DOIReference
x CitationFlavour
_ -> DOIReference -> CitationFlavour -> m ()
f DOIReference
x CitationFlavour
Flavour_Textcite))) ((DList DOIReference, (),
  (DOIReference -> CitationFlavour -> m ()) -> m ())
 -> (DList DOIReference, (),
     (DOIReference -> CitationFlavour -> m ()) -> m ()))
-> m (DList DOIReference, (),
      (DOIReference -> CitationFlavour -> m ()) -> m ())
-> m (DList DOIReference, (),
      (DOIReference -> CitationFlavour -> m ()) -> m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (DList DOIReference, (),
   (DOIReference -> CitationFlavour -> m ()) -> m ())
y

masterBibFile :: MonadIO m
      => FilePath    -- ^ A @.bib@ file containing entries for all relevant literature.
      -> (DOIReference -> m (Maybe BibTeX.T))
                     -- ^ Lookup-function, suitable for 'documentWithDOIReferences'.
masterBibFile :: PackageName -> DOIReference -> m (Maybe T)
masterBibFile PackageName
master (DOIReference PackageName
doi LaTeX
_) = do
   Either ParseError [T]
entries <- IO (Either ParseError [T]) -> m (Either ParseError [T])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseError [T]) -> m (Either ParseError [T]))
-> IO (Either ParseError [T]) -> m (Either ParseError [T])
forall a b. (a -> b) -> a -> b
$ Parser [T]
BibTeX.file Parser [T] -> PackageName -> IO (Either ParseError [T])
forall a. Parser a -> PackageName -> IO (Either ParseError a)
`Parsec.parseFromFile` PackageName
master
   Maybe T -> m (Maybe T)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe T -> m (Maybe T)) -> Maybe T -> m (Maybe T)
forall a b. (a -> b) -> a -> b
$ case Either ParseError [T]
entries of
     Right [T]
bibs -> (T -> Bool) -> [T] -> Maybe T
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find T -> Bool
hasThisDOI [T]
bibs
     Left ParseError
err   -> PackageName -> Maybe T
forall a. HasCallStack => PackageName -> a
error (PackageName -> Maybe T) -> PackageName -> Maybe T
forall a b. (a -> b) -> a -> b
$ ParseError -> PackageName
forall a. Show a => a -> PackageName
show ParseError
err
 where hasThisDOI :: T -> Bool
hasThisDOI T
bib = ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> Maybe PackageName -> Maybe PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageName -> [(PackageName, PackageName)] -> Maybe PackageName
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup PackageName
"doi" (T -> [(PackageName, PackageName)]
BibTeX.fields T
bib))
                          Maybe PackageName -> Maybe PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName -> Maybe PackageName
forall a. a -> Maybe a
Just (Char -> Char
toLower(Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>PackageName
doi)