{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.EndNote
   Copyright   : Copyright (C) 2022 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Parses EndNote XML bibliographies into a Pandoc document
with empty body and `references` and `nocite` fields
in the metadata.  A wildcard `nocite` is used so that
if the document is rendered in another format, the
entire bibliography will be printed.
-}
module Text.Pandoc.Readers.EndNote
  ( readEndNoteXML
  , readEndNoteXMLCitation
  )
where

import Text.Pandoc.Options
import Text.Pandoc.Definition
import Citeproc (Reference(..), ItemId(..), Val(..), Date(..), DateParts(..))
import qualified Citeproc
import Text.Pandoc.Builder as B
import Text.Pandoc.Error (PandocError(..))
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Citeproc.MetaValue (referenceToMetaValue)
import Text.Pandoc.Sources (Sources(..), ToSources(..), sourcesToText)
import Text.Pandoc.Citeproc.BibTeX (toName)
import Control.Applicative ((<|>))
import Control.Monad.Except (throwError)
import Control.Monad (mzero, unless)
import Text.Pandoc.XML.Light
    ( filterElementName,
      strContent,
      QName(qName),
      Element(..),
      Content(..),
      CData(..),
      filterElementsName,
      filterChildName,
      filterChildrenName,
      findAttrBy,
      parseXMLElement )
import qualified Data.Text.Lazy as TL
import qualified Data.Text as T
import Data.Text (Text)
import qualified Data.Map as M
import Safe (readMay)

-- | Read EndNote XML from an input string and return a Pandoc document.
-- The document will have only metadata, with an empty body.
-- The metadata will contain a `references` field with the
-- bibliography entries, and a `nocite` field with the wildcard `[@*]`.
readEndNoteXML :: (PandocMonad m, ToSources a)
               => ReaderOptions -> a -> m Pandoc
readEndNoteXML :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readEndNoteXML ReaderOptions
_opts a
inp = do
  let sources :: Sources
sources = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
inp
  [Reference Inlines]
refs <- Sources -> m [Reference Text]
forall (m :: * -> *).
PandocMonad m =>
Sources -> m [Reference Text]
readEndNoteXMLReferences Sources
sources m [Reference Text]
-> ([Reference Text] -> m [Reference Inlines])
-> m [Reference Inlines]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Reference Text -> m (Reference Inlines))
-> [Reference Text] -> m [Reference Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Text -> m Inlines) -> Reference Text -> m (Reference Inlines)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Inlines -> m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> m Inlines) -> (Text -> Inlines) -> Text -> m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
text))
  Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$
    Text -> Inlines -> Pandoc -> Pandoc
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"nocite" ([Citation] -> Inlines -> Inlines
cite [Citation {citationId :: Text
citationId = Text
"*"
                                     , citationPrefix :: [Inline]
citationPrefix = []
                                     , citationSuffix :: [Inline]
citationSuffix = []
                                     , citationMode :: CitationMode
citationMode = CitationMode
NormalCitation
                                     , citationNoteNum :: Int
citationNoteNum = Int
0
                                     , citationHash :: Int
citationHash = Int
0}] (Text -> Inlines
str Text
"[@*]")) (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$
    Text -> [MetaValue] -> Pandoc -> Pandoc
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"references" ((Reference Inlines -> MetaValue)
-> [Reference Inlines] -> [MetaValue]
forall a b. (a -> b) -> [a] -> [b]
map Reference Inlines -> MetaValue
referenceToMetaValue [Reference Inlines]
refs) (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$
    Blocks -> Pandoc
B.doc Blocks
forall a. Monoid a => a
mempty

readEndNoteXMLCitation :: PandocMonad m
                    => Sources -> m (Citeproc.Citation Text)
readEndNoteXMLCitation :: forall (m :: * -> *). PandocMonad m => Sources -> m (Citation Text)
readEndNoteXMLCitation Sources
sources = do
  Element
tree <- (Text -> m Element)
-> (Element -> m Element) -> Either Text Element -> m Element
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PandocError -> m Element
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Element)
-> (Text -> PandocError) -> Text -> m Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> PandocError
PandocXMLError Text
"") Element -> m Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Element -> m Element)
-> Either Text Element -> m Element
forall a b. (a -> b) -> a -> b
$
              Text -> Either Text Element
parseXMLElement (Text -> Text
TL.fromStrict (Text -> Text) -> (Sources -> Text) -> Sources -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sources -> Text
sourcesToText (Sources -> Text) -> Sources -> Text
forall a b. (a -> b) -> a -> b
$ Sources
sources)
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (QName -> Text
qName (Element -> QName
elName Element
tree) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"EndNote") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    PandocError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m ()) -> PandocError -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError Text
"" Text
"Expected EndNote element"
  let items :: [CitationItem Text]
items = (Element -> CitationItem Text) -> [Element] -> [CitationItem Text]
forall a b. (a -> b) -> [a] -> [b]
map Element -> CitationItem Text
toCitationItem ([Element] -> [CitationItem Text])
-> [Element] -> [CitationItem Text]
forall a b. (a -> b) -> a -> b
$ (QName -> Bool) -> Element -> [Element]
filterElementsName (Text -> QName -> Bool
name Text
"Cite") Element
tree
  Citation Text -> m (Citation Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Citation Text -> m (Citation Text))
-> Citation Text -> m (Citation Text)
forall a b. (a -> b) -> a -> b
$ Citeproc.Citation{
                     citationId :: Maybe Text
Citeproc.citationId = Maybe Text
forall a. Maybe a
Nothing
                   , citationNoteNumber :: Maybe Int
Citeproc.citationNoteNumber = Maybe Int
forall a. Maybe a
Nothing
                   , citationItems :: [CitationItem Text]
Citeproc.citationItems = [CitationItem Text]
items
                   }

readEndNoteXMLReferences :: PandocMonad m
                         => Sources -> m [Reference Text]
readEndNoteXMLReferences :: forall (m :: * -> *).
PandocMonad m =>
Sources -> m [Reference Text]
readEndNoteXMLReferences Sources
sources = do
  Element
tree <- (Text -> m Element)
-> (Element -> m Element) -> Either Text Element -> m Element
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PandocError -> m Element
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Element)
-> (Text -> PandocError) -> Text -> m Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> PandocError
PandocXMLError Text
"") Element -> m Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Element -> m Element)
-> Either Text Element -> m Element
forall a b. (a -> b) -> a -> b
$
              Text -> Either Text Element
parseXMLElement (Text -> Text
TL.fromStrict (Text -> Text) -> (Sources -> Text) -> Sources -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sources -> Text
sourcesToText (Sources -> Text) -> Sources -> Text
forall a b. (a -> b) -> a -> b
$ Sources
sources)
  let records :: [Element]
records = (QName -> Bool) -> Element -> [Element]
filterElementsName (Text -> QName -> Bool
name Text
"record") Element
tree
  [Reference Text] -> m [Reference Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Reference Text] -> m [Reference Text])
-> [Reference Text] -> m [Reference Text]
forall a b. (a -> b) -> a -> b
$ (Element -> Reference Text) -> [Element] -> [Reference Text]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Reference Text
recordToReference [Element]
records


toCitationItem :: Element -> Citeproc.CitationItem Text
toCitationItem :: Element -> CitationItem Text
toCitationItem Element
el =
    Citeproc.CitationItem{ citationItemId :: ItemId
Citeproc.citationItemId =
                              ItemId
-> (Reference Text -> ItemId) -> Maybe (Reference Text) -> ItemId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ItemId
forall a. Monoid a => a
mempty Reference Text -> ItemId
forall a. Reference a -> ItemId
referenceId Maybe (Reference Text)
mbref
                         , citationItemLabel :: Maybe Text
Citeproc.citationItemLabel = Maybe Text
forall a. Maybe a
Nothing
                         , citationItemLocator :: Maybe Text
Citeproc.citationItemLocator = Maybe Text
mbpages
                         , citationItemType :: CitationItemType
Citeproc.citationItemType = CitationItemType
Citeproc.NormalCite
                         , citationItemPrefix :: Maybe Text
Citeproc.citationItemPrefix = Maybe Text
mbprefix
                         , citationItemSuffix :: Maybe Text
Citeproc.citationItemSuffix = Maybe Text
mbsuffix
                         , citationItemData :: Maybe (Reference Text)
Citeproc.citationItemData = Maybe (Reference Text)
mbref
                         }
 where
  mbref :: Maybe (Reference Text)
mbref = Element -> Reference Text
recordToReference (Element -> Reference Text)
-> Maybe Element -> Maybe (Reference Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> Bool) -> Element -> Maybe Element
filterChildName (Text -> QName -> Bool
name Text
"record") Element
el
  mbprefix :: Maybe Text
mbprefix = Element -> Text
getText (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> Bool) -> Element -> Maybe Element
filterChildName (Text -> QName -> Bool
name Text
"Prefix") Element
el
  mbsuffix :: Maybe Text
mbsuffix = Element -> Text
getText (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> Bool) -> Element -> Maybe Element
filterChildName (Text -> QName -> Bool
name Text
"Suffix") Element
el
  mbpages :: Maybe Text
mbpages  = Element -> Text
getText (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> Bool) -> Element -> Maybe Element
filterChildName (Text -> QName -> Bool
name Text
"Pages") Element
el

name :: Text -> (QName -> Bool)
name :: Text -> QName -> Bool
name Text
t = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t) (Text -> Bool) -> (QName -> Text) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Text
qName

getText :: Element -> Text
getText :: Element -> Text
getText Element
el = Content -> Text
getText' (Element -> Content
Elem Element
el)
 where
  getText' :: Content -> Text
getText' (Elem Element
el') = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Content -> Text) -> [Content] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Content -> Text
getText' ([Content] -> [Text]) -> [Content] -> [Text]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
el'
  getText' (Text CData
cd) = CData -> Text
cdData CData
cd
  getText' (CRef Text
_) = Text
forall a. Monoid a => a
mempty

recordToReference :: Element -> Reference Text
recordToReference :: Element -> Reference Text
recordToReference Element
e =
  Reference{ referenceId :: ItemId
referenceId = Text -> ItemId
ItemId Text
refid,
             referenceType :: Text
referenceType = Text
reftype,
             referenceDisambiguation :: Maybe DisambiguationData
referenceDisambiguation = Maybe DisambiguationData
forall a. Maybe a
Nothing,
             referenceVariables :: Map Variable (Val Text)
referenceVariables = Map Variable (Val Text)
refvars }

 where
   -- get strContent, recursing inside style elements:
   refid :: Text
refid = Text -> (Element -> Text) -> Maybe Element -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (Text -> Text
T.strip (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
strContent)
           ((QName -> Bool) -> Element -> Maybe Element
filterElementName (Text -> QName -> Bool
name Text
"key") Element
e
            Maybe Element -> Maybe Element -> Maybe Element
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (QName -> Bool) -> Element -> Maybe Element
filterElementName (Text -> QName -> Bool
name Text
"rec-number") Element
e)
   reftype :: Text
reftype = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"document" Text -> Text
toCslReferenceType
              ((QName -> Bool) -> Element -> Maybe Element
filterElementName (Text -> QName -> Bool
name Text
"ref-type") Element
e Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                (QName -> Bool) -> Element -> Maybe Text
findAttrBy (Text -> QName -> Bool
name Text
"name"))
   authors :: [Name]
authors =
     (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"contributors") Element
e [Element] -> (Element -> [Element]) -> [Element]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"authors") [Element] -> (Element -> [Element]) -> [Element]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"author") [Element] -> (Element -> [Name]) -> [Name]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     Options -> [Inline] -> [Name]
forall (m :: * -> *). MonadPlus m => Options -> [Inline] -> m Name
toName [] ([Inline] -> [Name]) -> (Element -> [Inline]) -> Element -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Inline])
-> (Element -> Inlines) -> Element -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Text -> Inlines
B.text (Text -> Inlines) -> (Element -> Text) -> Element -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
getText
   titles :: [(Variable, Val Text)]
titles = do
     Element
x <- (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"titles") Element
e
     (Variable
key, Text
name') <- [(Variable
"title", Text
"title"),
                      (Variable
"container-title", Text
"secondary-title")]
     (Variable
key,) (Val Text -> (Variable, Val Text))
-> (Element -> Val Text) -> Element -> (Variable, Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Val Text
forall a. a -> Val a
FancyVal (Text -> Val Text) -> (Element -> Text) -> Element -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
getText (Element -> (Variable, Val Text))
-> [Element] -> [(Variable, Val Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
name') Element
x
   pages :: [(Variable, Val Text)]
pages = (Variable
"pages",) (Val Text -> (Variable, Val Text))
-> (Element -> Val Text) -> Element -> (Variable, Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Val Text
forall a. a -> Val a
FancyVal (Text -> Val Text) -> (Element -> Text) -> Element -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
getText (Element -> (Variable, Val Text))
-> [Element] -> [(Variable, Val Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"pages") Element
e
   volume :: [(Variable, Val Text)]
volume = (Variable
"volume",) (Val Text -> (Variable, Val Text))
-> (Element -> Val Text) -> Element -> (Variable, Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Val Text
forall a. a -> Val a
FancyVal (Text -> Val Text) -> (Element -> Text) -> Element -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
getText (Element -> (Variable, Val Text))
-> [Element] -> [(Variable, Val Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"volume") Element
e
   number :: [(Variable, Val Text)]
number = (Variable
"number",) (Val Text -> (Variable, Val Text))
-> (Element -> Val Text) -> Element -> (Variable, Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Val Text
forall a. a -> Val a
FancyVal (Text -> Val Text) -> (Element -> Text) -> Element -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
getText (Element -> (Variable, Val Text))
-> [Element] -> [(Variable, Val Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"number") Element
e
   isbn :: [(Variable, Val Text)]
isbn = (Variable
"isbn",) (Val Text -> (Variable, Val Text))
-> (Element -> Val Text) -> Element -> (Variable, Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Val Text
forall a. a -> Val a
FancyVal (Text -> Val Text) -> (Element -> Text) -> Element -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
getText (Element -> (Variable, Val Text))
-> [Element] -> [(Variable, Val Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"isbn") Element
e
   publisher :: [(Variable, Val Text)]
publisher = (Variable
"publisher",) (Val Text -> (Variable, Val Text))
-> (Element -> Val Text) -> Element -> (Variable, Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Val Text
forall a. a -> Val a
FancyVal (Text -> Val Text) -> (Element -> Text) -> Element -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
getText (Element -> (Variable, Val Text))
-> [Element] -> [(Variable, Val Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"publisher") Element
e
   originalPublisher :: [(Variable, Val Text)]
originalPublisher =
     (Variable
"original-publisher",) (Val Text -> (Variable, Val Text))
-> (Element -> Val Text) -> Element -> (Variable, Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Val Text
forall a. a -> Val a
FancyVal (Text -> Val Text) -> (Element -> Text) -> Element -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
getText (Element -> (Variable, Val Text))
-> [Element] -> [(Variable, Val Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"orig-pub") Element
e
   publisherPlace :: [(Variable, Val Text)]
publisherPlace =
     (Variable
"publisher-place",) (Val Text -> (Variable, Val Text))
-> (Element -> Val Text) -> Element -> (Variable, Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Val Text
forall a. a -> Val a
FancyVal (Text -> Val Text) -> (Element -> Text) -> Element -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
getText (Element -> (Variable, Val Text))
-> [Element] -> [(Variable, Val Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"pub-location") Element
e
   abstract :: [(Variable, Val Text)]
abstract = (Variable
"abstract",) (Val Text -> (Variable, Val Text))
-> (Element -> Val Text) -> Element -> (Variable, Val Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Val Text
forall a. a -> Val a
FancyVal (Text -> Val Text) -> (Element -> Text) -> Element -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
getText (Element -> (Variable, Val Text))
-> [Element] -> [(Variable, Val Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"abstract") Element
e
   dates :: [(Variable, Val a)]
dates = (Variable
"issued",) (Val a -> (Variable, Val a))
-> (Element -> Val a) -> Element -> (Variable, Val a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Val a
forall {a}. Element -> Val a
toDate (Element -> (Variable, Val a)) -> [Element] -> [(Variable, Val a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"dates") Element
e
   toDate :: Element -> Val a
toDate Element
e' = Date -> Val a
forall a. Date -> Val a
DateVal (Date -> Val a) -> Date -> Val a
forall a b. (a -> b) -> a -> b
$
    Date { dateParts :: [DateParts]
dateParts = Element -> [DateParts]
toDateParts Element
e'
         , dateCirca :: Bool
dateCirca = Bool
False
         , dateSeason :: Maybe Int
dateSeason = Maybe Int
forall a. Maybe a
Nothing
         , dateLiteral :: Maybe Text
dateLiteral = Maybe Text
forall a. Maybe a
Nothing }
   toDateParts :: Element -> [DateParts]
toDateParts Element
e' = do
    Element
x <- (QName -> Bool) -> Element -> [Element]
filterChildrenName (Text -> QName -> Bool
name Text
"year") Element
e'
    case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (String -> Maybe Int)
-> (Element -> String) -> Element -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Element -> Text) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
getText (Element -> Maybe Int) -> Element -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Element
x of
      Maybe Int
Nothing -> [DateParts]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      Just Int
y  -> DateParts -> [DateParts]
forall (m :: * -> *) a. Monad m => a -> m a
return (DateParts -> [DateParts]) -> DateParts -> [DateParts]
forall a b. (a -> b) -> a -> b
$ [Int] -> DateParts
DateParts [Int
y]

   refvars :: Map Variable (Val Text)
refvars = [(Variable, Val Text)] -> Map Variable (Val Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Variable, Val Text)] -> Map Variable (Val Text))
-> [(Variable, Val Text)] -> Map Variable (Val Text)
forall a b. (a -> b) -> a -> b
$
     [ (Variable
"author", [Name] -> Val Text
forall a. [Name] -> Val a
NamesVal [Name]
authors) | Bool -> Bool
not ([Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
authors) ] [(Variable, Val Text)]
-> [(Variable, Val Text)] -> [(Variable, Val Text)]
forall a. [a] -> [a] -> [a]
++
     [(Variable, Val Text)]
titles [(Variable, Val Text)]
-> [(Variable, Val Text)] -> [(Variable, Val Text)]
forall a. [a] -> [a] -> [a]
++
     [(Variable, Val Text)]
pages [(Variable, Val Text)]
-> [(Variable, Val Text)] -> [(Variable, Val Text)]
forall a. [a] -> [a] -> [a]
++
     [(Variable, Val Text)]
volume [(Variable, Val Text)]
-> [(Variable, Val Text)] -> [(Variable, Val Text)]
forall a. [a] -> [a] -> [a]
++
     [(Variable, Val Text)]
number [(Variable, Val Text)]
-> [(Variable, Val Text)] -> [(Variable, Val Text)]
forall a. [a] -> [a] -> [a]
++
     [(Variable, Val Text)]
isbn [(Variable, Val Text)]
-> [(Variable, Val Text)] -> [(Variable, Val Text)]
forall a. [a] -> [a] -> [a]
++
     [(Variable, Val Text)]
forall {a}. [(Variable, Val a)]
dates [(Variable, Val Text)]
-> [(Variable, Val Text)] -> [(Variable, Val Text)]
forall a. [a] -> [a] -> [a]
++
     [(Variable, Val Text)]
publisher [(Variable, Val Text)]
-> [(Variable, Val Text)] -> [(Variable, Val Text)]
forall a. [a] -> [a] -> [a]
++
     [(Variable, Val Text)]
originalPublisher [(Variable, Val Text)]
-> [(Variable, Val Text)] -> [(Variable, Val Text)]
forall a. [a] -> [a] -> [a]
++
     [(Variable, Val Text)]
publisherPlace [(Variable, Val Text)]
-> [(Variable, Val Text)] -> [(Variable, Val Text)]
forall a. [a] -> [a] -> [a]
++
     [(Variable, Val Text)]
abstract

toCslReferenceType :: Text -> Text
toCslReferenceType :: Text -> Text
toCslReferenceType Text
t =
  case Text
t of
    Text
"Aggregated Database" -> Text
"dataset"
    Text
"Ancient Text" -> Text
"classic"
    Text
"Artwork" -> Text
"graphic"
    Text
"Audiovisual Material" -> Text
"graphic"
    Text
"Bill" -> Text
"legislation"
    Text
"Blog" -> Text
"post-weblog"
    Text
"Book" -> Text
"book"
    Text
"Book Section" -> Text
"chapter"
    Text
"Case" -> Text
"legal_case"
    Text
"Catalog" -> Text
"document"
    Text
"Chart or Table" -> Text
"graphic"
    Text
"Classical Work" -> Text
"classic"
    Text
"Computer program" -> Text
"software"
    Text
"Conference Paper" -> Text
"article"
    Text
"Conference Proceedings" -> Text
"periodical"
    Text
"Dataset" -> Text
"dataset"
    Text
"Dictionary" -> Text
"book"
    Text
"Edited Book" -> Text
"book"
    Text
"Electronic Article" -> Text
"article"
    Text
"Electronic Book" -> Text
"book"
    Text
"Electronic Book Section" -> Text
"chapter"
    Text
"Encyclopedia" -> Text
"book"
    Text
"Equation" -> Text
"document"
    Text
"Figure" -> Text
"graphic"
    Text
"Film or Broadcast" -> Text
"motion_picture"
    Text
"Government Document" -> Text
"document"
    Text
"Grant" -> Text
"document"
    Text
"Hearing" -> Text
"hearing"
    Text
"Interview" -> Text
"interview"
    Text
"Journal Article" -> Text
"article-journal"
    Text
"Legal Rule or Regulation" -> Text
"regulation"
    Text
"Magazine Article" -> Text
"article-magazine"
    Text
"Manuscript" -> Text
"manuscript"
    Text
"Map" -> Text
"map"
    Text
"Music" -> Text
"musical_score"
    Text
"Newspaper Article" -> Text
"article-newspaper"
    Text
"Online Database" -> Text
"dataset"
    Text
"Online Multimedia" -> Text
"webpage"
    Text
"Pamphlet" -> Text
"pamphlet"
    Text
"Patent" -> Text
"patent"
    Text
"Personal Communication" -> Text
"personal_communication"
    Text
"Podcast" -> Text
"document"
    Text
"Press Release" -> Text
"report"
    Text
"Report" -> Text
"report"
    Text
"Serial" -> Text
"periodical"
    Text
"Standard" -> Text
"standard"
    Text
"Statute" -> Text
"legislation"
    Text
"Thesis" -> Text
"thesis"
    Text
"Unpublished Work" -> Text
"unpublished"
    Text
"Web Page" -> Text
"webpage"
    Text
_ -> Text
"document"