{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.CSL.Pandoc (processCites, processCites')
where

import Prelude
import           Control.Applicative      ((<|>))
import qualified Control.Exception        as E
import           Control.Monad
import           Control.Monad.State
import           Data.Aeson
import qualified Data.ByteString.Lazy     as L
import           Data.Char                (isDigit, isPunctuation, isSpace)
import qualified Data.Map                 as M
import qualified Data.Set                 as Set
import qualified Data.Text                as T
import           Data.Maybe               (fromMaybe)
import           System.Directory         (getAppUserDataDirectory)
import           System.Environment       (getEnv)
import           System.FilePath
import           System.IO.Error          (isDoesNotExistError)
import           System.SetEnv            (setEnv)
import           Text.CSL.Data            (getDefaultCSL)
import           Text.CSL.Exception
import           Text.CSL.Input.Bibutils  (convertRefs, readBiblioFile)
import           Text.CSL.Output.Pandoc   (renderPandoc, renderPandoc',
                      headInline, initInline, tailInline, toCapital)
import           Text.CSL.Parser
import           Text.CSL.Proc
import           Text.CSL.Reference       hiding (Value, processCites)
import           Text.CSL.Style           hiding (Citation (..), Cite (..))
import qualified Text.CSL.Style           as CSL
import           Text.CSL.Util            (findFile, lastInline,
                                           parseRomanNumeral, splitStrWhen, tr',
                                           trim)
import           Text.HTML.TagSoup.Entity (lookupEntity)
import           Text.Pandoc
import           Text.Pandoc.Builder      (deleteMeta, setMeta)
import           Text.Pandoc.Shared       (stringify, ordNub)
import           Text.Pandoc.Walk
import           Text.Parsec              hiding (State, (<|>))

-- | Process a 'Pandoc' document by adding citations formatted
-- according to a CSL style.  Add a bibliography (if one is called
-- for) at the end of the document.
processCites :: Style -> [Reference] -> Pandoc -> Pandoc
processCites :: Style -> [Reference] -> Pandoc -> Pandoc
processCites style :: Style
style refs :: [Reference]
refs (Pandoc m1 :: Meta
m1 b1 :: [Block]
b1) =
  let metanocites :: Maybe MetaValue
metanocites   = Text -> Meta -> Maybe MetaValue
lookupMeta "nocite" Meta
m1
      nocites :: Maybe [[Citation]]
nocites       = [Reference] -> [[Citation]] -> [[Citation]]
mkNociteWildcards [Reference]
refs ([[Citation]] -> [[Citation]])
-> (MetaValue -> [[Citation]]) -> MetaValue -> [[Citation]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> [[Citation]]) -> MetaValue -> [[Citation]]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [[Citation]]
getCitation (MetaValue -> [[Citation]])
-> Maybe MetaValue -> Maybe [[Citation]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MetaValue
metanocites
      Pandoc m2 :: Meta
m2 b2 :: [Block]
b2  = State Int Pandoc -> Int -> Pandoc
forall s a. State s a -> s -> a
evalState ((Inline -> StateT Int Identity Inline)
-> Pandoc -> State Int Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Inline -> StateT Int Identity Inline
setHashes (Pandoc -> State Int Pandoc) -> Pandoc -> State Int Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc (Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
deleteMeta "nocite" Meta
m1) [Block]
b1) 1
      grps :: [[Citation]]
grps          = (Inline -> [[Citation]]) -> Pandoc -> [[Citation]]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [[Citation]]
getCitation (Meta -> [Block] -> Pandoc
Pandoc Meta
m2 [Block]
b2) [[Citation]] -> [[Citation]] -> [[Citation]]
forall a. [a] -> [a] -> [a]
++ [[Citation]] -> Maybe [[Citation]] -> [[Citation]]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [[Citation]]
nocites
      locMap :: LocatorMap
locMap        = Style -> LocatorMap
locatorMap Style
style
      result :: BiblioData
result        = ProcOpts -> Style -> [Reference] -> Citations -> BiblioData
citeproc ProcOpts
procOpts{ linkCitations :: Bool
linkCitations = Meta -> Bool
isLinkCitations Meta
m2}
                        Style
style [Reference]
refs (Style -> Citations -> Citations
setNearNote Style
style (Citations -> Citations) -> Citations -> Citations
forall a b. (a -> b) -> a -> b
$
                        ([Citation] -> [Cite]) -> [[Citation]] -> Citations
forall a b. (a -> b) -> [a] -> [b]
map ((Citation -> Cite) -> [Citation] -> [Cite]
forall a b. (a -> b) -> [a] -> [b]
map (LocatorMap -> Citation -> Cite
toCslCite LocatorMap
locMap)) [[Citation]]
grps)
      cits_map :: Map [Citation] Formatted
cits_map      = String -> Map [Citation] Formatted -> Map [Citation] Formatted
forall a. String -> a -> a
tr' "cits_map" (Map [Citation] Formatted -> Map [Citation] Formatted)
-> Map [Citation] Formatted -> Map [Citation] Formatted
forall a b. (a -> b) -> a -> b
$ [([Citation], Formatted)] -> Map [Citation] Formatted
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([Citation], Formatted)] -> Map [Citation] Formatted)
-> [([Citation], Formatted)] -> Map [Citation] Formatted
forall a b. (a -> b) -> a -> b
$ [[Citation]] -> [Formatted] -> [([Citation], Formatted)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Citation]]
grps (BiblioData -> [Formatted]
citations BiblioData
result)
      biblioList :: [Block]
biblioList    = ((Formatted, String) -> Block) -> [(Formatted, String)] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map (Style -> (Formatted, String) -> Block
renderPandoc' Style
style) ([(Formatted, String)] -> [Block])
-> [(Formatted, String)] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Formatted] -> [String] -> [(Formatted, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (BiblioData -> [Formatted]
bibliography BiblioData
result) (BiblioData -> [String]
citationIds BiblioData
result)
      moveNotes :: Bool
moveNotes     = Bool -> (MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True MetaValue -> Bool
truish (Maybe MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall a b. (a -> b) -> a -> b
$
                        Text -> Meta -> Maybe MetaValue
lookupMeta "notes-after-punctuation" Meta
m1
      Pandoc m3 :: Meta
m3 bs :: [Block]
bs  = ([Inline] -> [Inline]) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
style) (Pandoc -> Pandoc) -> (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pandoc -> Pandoc
deNote (Pandoc -> Pandoc) -> (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        (Inline -> Inline) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Style -> Map [Citation] Formatted -> Inline -> Inline
processCite Style
style Map [Citation] Formatted
cits_map) (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
m2 [Block]
b2
      m :: Meta
m             = case Maybe MetaValue
metanocites of
                            Nothing -> Meta
m3
                            Just x :: MetaValue
x  -> Text -> MetaValue -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta "nocite" MetaValue
x Meta
m3
      notemap :: Map String Int
notemap       = Pandoc -> Map String Int
mkNoteMap (Meta -> [Block] -> Pandoc
Pandoc Meta
m3 [Block]
bs)
      hanging :: Bool
hanging       = Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "true")
                       (Style -> Maybe Bibliography
biblio Style
style Maybe Bibliography
-> (Bibliography -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                        String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "hanging-indent" ([(String, String)] -> Maybe String)
-> (Bibliography -> [(String, String)])
-> Bibliography
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bibliography -> [(String, String)]
bibOptions)
  in  Meta -> [Block] -> Pandoc
Pandoc Meta
m ([Block] -> Pandoc) -> [Block] -> Pandoc
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Map String Int -> Inline -> Inline
addFirstNoteNumber Map String Int
notemap)
               ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ ([Inline] -> [Inline]) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk ((Inline -> [Inline]) -> [Inline] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
removeNocaseSpans)
               ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Bool -> Meta -> [Block] -> [Block] -> [Block]
insertRefs Bool
hanging Meta
m [Block]
biblioList [Block]
bs

addFirstNoteNumber :: M.Map String Int -> Inline -> Inline
addFirstNoteNumber :: Map String Int -> Inline -> Inline
addFirstNoteNumber notemap :: Map String Int
notemap
  s :: Inline
s@(Span ("",["first-reference-note-number"],[("refid",refid :: Text
refid)]) _)
  = case String -> Map String Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> String
T.unpack Text
refid) Map String Int
notemap of
         Nothing -> Inline
s
         Just n :: Int
n  -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
addFirstNoteNumber _ -- see below, these spans added by deNote
  (Note [Para (Span ("",["reference-id-list"],_) [] : ils :: [Inline]
ils)])
  = [Block] -> Inline
Note [[Inline] -> Block
Para [Inline]
ils]
addFirstNoteNumber _ x :: Inline
x = Inline
x

mkNoteMap :: Pandoc -> M.Map String Int
mkNoteMap :: Pandoc -> Map String Int
mkNoteMap doc :: Pandoc
doc =
  ((Int, String) -> Map String Int -> Map String Int)
-> Map String Int -> [(Int, String)] -> Map String Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, String) -> Map String Int -> Map String Int
go Map String Int
forall a. Monoid a => a
mempty ([(Int, String)] -> Map String Int)
-> [(Int, String)] -> Map String Int
forall a b. (a -> b) -> a -> b
$ [(Int, [String])] -> [(Int, String)]
splitUp ([(Int, [String])] -> [(Int, String)])
-> [(Int, [String])] -> [(Int, String)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[String]] -> [(Int, [String])]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] ([[String]] -> [(Int, [String])])
-> [[String]] -> [(Int, [String])]
forall a b. (a -> b) -> a -> b
$ (Inline -> [[String]]) -> Pandoc -> [[String]]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [[String]]
getNoteCitationIds Pandoc
doc
  where
   splitUp :: [(Int, [String])] -> [(Int, String)]
   splitUp :: [(Int, [String])] -> [(Int, String)]
splitUp = ((Int, [String]) -> [(Int, String)])
-> [(Int, [String])] -> [(Int, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(n :: Int
n,ss :: [String]
ss) -> (String -> (Int, String)) -> [String] -> [(Int, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
n,) [String]
ss)
   go :: (Int, String) -> M.Map String Int -> M.Map String Int
   go :: (Int, String) -> Map String Int -> Map String Int
go (notenumber :: Int
notenumber, citeid :: String
citeid) = String -> Int -> Map String Int -> Map String Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
citeid Int
notenumber

-- if document contains a Div with id="refs", insert
-- references as its contents.  Otherwise, insert references
-- at the end of the document in a Div with id="refs"
insertRefs :: Bool -> Meta -> [Block] -> [Block] -> [Block]
insertRefs :: Bool -> Meta -> [Block] -> [Block] -> [Block]
insertRefs _ _  []   bs :: [Block]
bs = [Block]
bs
insertRefs hanging :: Bool
hanging meta :: Meta
meta refs :: [Block]
refs bs :: [Block]
bs =
  if Meta -> Bool
isRefRemove Meta
meta
     then [Block]
bs
     else case State Bool [Block] -> Bool -> ([Block], Bool)
forall s a. State s a -> s -> (a, s)
runState ((Block -> StateT Bool Identity Block)
-> [Block] -> State Bool [Block]
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Block -> StateT Bool Identity Block
go [Block]
bs) Bool
False of
               (bs' :: [Block]
bs', True) -> [Block]
bs'
               (_, False)  ->
                  case [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
bs of
                        Header lev :: Int
lev (id' :: Text
id',classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) ys :: [Inline]
ys : xs :: [Block]
xs ->
                          [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
xs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
                            [Int -> Attr -> [Inline] -> Block
Header Int
lev (Text
id',[Text] -> [Text]
forall a. (IsString a, Eq a) => [a] -> [a]
addUnNumbered [Text]
classes,[(Text, Text)]
kvs) [Inline]
ys,
                             Attr -> [Block] -> Block
Div ("refs",[Text]
refclasses,[]) [Block]
refs]
                        _   -> [Block]
bs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
refHeader [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
                                [Attr -> [Block] -> Block
Div ("refs",[Text]
refclasses,[]) [Block]
refs]
  where
   refclasses :: [Text]
refclasses = "references" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: if Bool
hanging then ["hanging-indent"] else []
   go :: Block -> State Bool Block
   go :: Block -> StateT Bool Identity Block
go (Div ("refs",cs :: [Text]
cs,kvs :: [(Text, Text)]
kvs) xs :: [Block]
xs) = do
     Bool -> StateT Bool Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Bool
True
     -- refHeader isn't used if you have an explicit references div
     let cs' :: [Text]
cs' = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
cs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
refclasses
     Block -> StateT Bool Identity Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> StateT Bool Identity Block)
-> Block -> StateT Bool Identity Block
forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
Div ("refs",[Text]
cs',[(Text, Text)]
kvs) ([Block]
xs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
refs)
   go x :: Block
x = Block -> StateT Bool Identity Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
x
   addUnNumbered :: [a] -> [a]
addUnNumbered cs :: [a]
cs = "unnumbered" a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a
c | a
c <- [a]
cs, a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= "unnumbered"]
   refHeader :: [Block]
refHeader = case Meta -> Maybe [Inline]
refTitle Meta
meta of
                Just ils :: [Inline]
ils ->
                  [Int -> Attr -> [Inline] -> Block
Header 1 ("bibliography", ["unnumbered"], []) [Inline]
ils]
                _        -> []

refTitle :: Meta -> Maybe [Inline]
refTitle :: Meta -> Maybe [Inline]
refTitle meta :: Meta
meta =
  case Text -> Meta -> Maybe MetaValue
lookupMeta "reference-section-title" Meta
meta of
    Just (MetaString s :: Text
s)           -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Text -> Inline
Str Text
s]
    Just (MetaInlines ils :: [Inline]
ils)        -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
    Just (MetaBlocks [Plain ils :: [Inline]
ils]) -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
    Just (MetaBlocks [Para ils :: [Inline]
ils])  -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
    _                             -> Maybe [Inline]
forall a. Maybe a
Nothing

isRefRemove :: Meta -> Bool
isRefRemove :: Meta -> Bool
isRefRemove meta :: Meta
meta =
  Bool -> (MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False MetaValue -> Bool
truish (Maybe MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta "suppress-bibliography" Meta
meta

isLinkCitations :: Meta -> Bool
isLinkCitations :: Meta -> Bool
isLinkCitations meta :: Meta
meta =
  Bool -> (MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False MetaValue -> Bool
truish (Maybe MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta "link-citations" Meta
meta

truish :: MetaValue -> Bool
truish :: MetaValue -> Bool
truish (MetaBool t :: Bool
t) = Bool
t
truish (MetaString s :: Text
s) = String -> Bool
isYesValue (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
s)
truish (MetaInlines ils :: [Inline]
ils) = String -> Bool
isYesValue (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils))
truish (MetaBlocks [Plain ils :: [Inline]
ils]) = String -> Bool
isYesValue (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils))
truish _ = Bool
False

isYesValue :: String -> Bool
isYesValue :: String -> Bool
isYesValue "t" = Bool
True
isYesValue "true" = Bool
True
isYesValue "yes" = Bool
True
isYesValue "on" = Bool
True
isYesValue _ = Bool
False

-- if the 'nocite' Meta field contains a citation with id = '*',
-- create a cite with to all the references.
mkNociteWildcards :: [Reference] -> [[Citation]] -> [[Citation]]
mkNociteWildcards :: [Reference] -> [[Citation]] -> [[Citation]]
mkNociteWildcards refs :: [Reference]
refs = ([Citation] -> [Citation]) -> [[Citation]] -> [[Citation]]
forall a b. (a -> b) -> [a] -> [b]
map [Citation] -> [Citation]
expandStar
  where expandStar :: [Citation] -> [Citation]
expandStar cs :: [Citation]
cs =
         case [Citation
c | Citation
c <- [Citation]
cs
                 , Citation -> Text
citationId Citation
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "*"] of
              [] -> [Citation]
cs
              _  -> [Citation]
allcites
        allcites :: [Citation]
allcites = (Reference -> Citation) -> [Reference] -> [Citation]
forall a b. (a -> b) -> [a] -> [b]
map (\ref :: Reference
ref -> Citation :: Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
Citation{
                                  citationId :: Text
citationId = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Literal -> String
unLiteral (Reference -> Literal
refId Reference
ref),
                                  citationPrefix :: [Inline]
citationPrefix = [],
                                  citationSuffix :: [Inline]
citationSuffix = [],
                                  citationMode :: CitationMode
citationMode = CitationMode
NormalCitation,
                                  citationNoteNum :: Int
citationNoteNum = 0,
                                  citationHash :: Int
citationHash = 0 }) [Reference]
refs

removeNocaseSpans :: Inline -> [Inline]
removeNocaseSpans :: Inline -> [Inline]
removeNocaseSpans (Span ("",["nocase"],[]) xs :: [Inline]
xs) = [Inline]
xs
removeNocaseSpans x :: Inline
x                            = [Inline
x]

-- | Process a 'Pandoc' document by adding citations formatted
-- according to a CSL style.  The style filename is derived from
-- the `csl` field of the metadata, and the references are taken
-- from the `references` field or read from a file in the `bibliography`
-- field.
processCites' :: Pandoc -> IO Pandoc
processCites' :: Pandoc -> IO Pandoc
processCites' (Pandoc meta :: Meta
meta blocks :: [Block]
blocks) = do
  Maybe String
mbcsldir <- IO (Maybe String)
-> (IOError -> IO (Maybe String)) -> IO (Maybe String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getAppUserDataDirectory "csl") ((IOError -> IO (Maybe String)) -> IO (Maybe String))
-> (IOError -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \e :: IOError
e ->
                 if IOError -> Bool
isDoesNotExistError IOError
e
                    then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                    else IOError -> IO (Maybe String)
forall e a. Exception e => e -> IO a
E.throwIO IOError
e
  Maybe String
mbpandocdir <- IO (Maybe String)
-> (IOError -> IO (Maybe String)) -> IO (Maybe String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getAppUserDataDirectory "pandoc") ((IOError -> IO (Maybe String)) -> IO (Maybe String))
-> (IOError -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \e :: IOError
e ->
                 if IOError -> Bool
isDoesNotExistError IOError
e
                    then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                    else IOError -> IO (Maybe String)
forall e a. Exception e => e -> IO a
E.throwIO IOError
e
  let inlineRefError :: String -> a
inlineRefError s :: String
s = CiteprocException -> a
forall a e. Exception e => e -> a
E.throw (CiteprocException -> a) -> CiteprocException -> a
forall a b. (a -> b) -> a -> b
$ String -> CiteprocException
ErrorParsingReferences String
s
  let inlineRefs :: [Reference]
inlineRefs = (String -> [Reference])
-> ([Reference] -> [Reference])
-> Either String [Reference]
-> [Reference]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> [Reference]
forall a. String -> a
inlineRefError [Reference] -> [Reference]
forall a. a -> a
id
                   (Either String [Reference] -> [Reference])
-> Either String [Reference] -> [Reference]
forall a b. (a -> b) -> a -> b
$ Maybe MetaValue -> Either String [Reference]
convertRefs (Maybe MetaValue -> Either String [Reference])
-> Maybe MetaValue -> Either String [Reference]
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta "references" Meta
meta
  let cslfile :: Maybe String
cslfile = (Text -> Meta -> Maybe MetaValue
lookupMeta "csl" Meta
meta Maybe MetaValue -> Maybe MetaValue -> Maybe MetaValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Meta -> Maybe MetaValue
lookupMeta "citation-style" Meta
meta)
                Maybe MetaValue -> (MetaValue -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe String
toPath
  let mbLocale :: Maybe String
mbLocale = (Text -> Meta -> Maybe MetaValue
lookupMeta "lang" Meta
meta Maybe MetaValue -> Maybe MetaValue -> Maybe MetaValue
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> Meta -> Maybe MetaValue
lookupMeta "locale" Meta
meta)
                   Maybe MetaValue -> (MetaValue -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe String
toPath
  let tryReadCSLFile :: Maybe String -> String -> IO Style
tryReadCSLFile Nothing _  = IO Style
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      tryReadCSLFile (Just d :: String
d) f :: String
f = IO Style -> (SomeException -> IO Style) -> IO Style
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Maybe String -> String -> IO Style
readCSLFile Maybe String
mbLocale (String
d String -> String -> String
</> String
f))
                                     (\(SomeException
_ :: E.SomeException) -> IO Style
forall (m :: * -> *) a. MonadPlus m => m a
mzero)
  Style
csl <- case Maybe String
cslfile of
               Just f :: String
f | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
f) -> Maybe String -> String -> IO Style
readCSLFile Maybe String
mbLocale String
f
               _ ->  Maybe String -> String -> IO Style
tryReadCSLFile Maybe String
mbpandocdir "default.csl"
                   IO Style -> IO Style -> IO Style
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String -> String -> IO Style
tryReadCSLFile Maybe String
mbcsldir "chicago-author-date.csl"
                   IO Style -> IO Style -> IO Style
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (IO ByteString
getDefaultCSL IO ByteString -> (ByteString -> IO Style) -> IO Style
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                             Maybe String -> Style -> IO Style
localizeCSL Maybe String
mbLocale (Style -> IO Style)
-> (ByteString -> Style) -> ByteString -> IO Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Style
parseCSL')
  -- set LANG environment from locale; this affects unicode collation
  -- if pandoc-citeproc compiled with unicode_collation flag
  case Style -> [Locale]
styleLocale Style
csl of
       (l :: Locale
l:_) -> do
         String -> String -> IO ()
setEnv "LC_ALL" (Locale -> String
localeLang Locale
l)
         String -> String -> IO ()
setEnv "LANG"   (Locale -> String
localeLang Locale
l)
       []    -> do
         String
envlang <- String -> IO String
getEnv "LANG"
         if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
envlang
            then do
              -- Note that LANG needs to be set for bibtex conversion:
              String -> String -> IO ()
setEnv "LANG" "en_US.UTF-8"
              String -> String -> IO ()
setEnv "LC_ALL" "en_US.UTF-8"
            else
              String -> String -> IO ()
setEnv "LC_ALL" String
envlang
  let citids :: Set String
citids = (Inline -> Set String) -> Pandoc -> Set String
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Set String
getCitationIds (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks)
  let idpred :: String -> Bool
idpred = if "*" String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
citids
                  then Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True
                  else (String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
citids)
  [Reference]
bibRefs <- (String -> Bool) -> MetaValue -> IO [Reference]
getBibRefs String -> Bool
idpred (MetaValue -> IO [Reference]) -> MetaValue -> IO [Reference]
forall a b. (a -> b) -> a -> b
$ MetaValue -> Maybe MetaValue -> MetaValue
forall a. a -> Maybe a -> a
fromMaybe ([MetaValue] -> MetaValue
MetaList [])
                               (Maybe MetaValue -> MetaValue) -> Maybe MetaValue -> MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta "bibliography" Meta
meta
  let refs :: [Reference]
refs = [Reference]
inlineRefs [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++ [Reference]
bibRefs
  let cslAbbrevFile :: Maybe String
cslAbbrevFile = Text -> Meta -> Maybe MetaValue
lookupMeta "citation-abbreviations" Meta
meta Maybe MetaValue -> (MetaValue -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe String
toPath
  let skipLeadingSpace :: ByteString -> ByteString
skipLeadingSpace = (Word8 -> Bool) -> ByteString -> ByteString
L.dropWhile (\s :: Word8
s -> Word8
s Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 32 Bool -> Bool -> Bool
|| (Word8
s Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 9 Bool -> Bool -> Bool
&& Word8
s Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 13))
  Abbreviations
abbrevs <- IO Abbreviations
-> (String -> IO Abbreviations) -> Maybe String -> IO Abbreviations
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Abbreviations -> IO Abbreviations
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String (Map String LocatorMap) -> Abbreviations
Abbreviations Map String (Map String LocatorMap)
forall k a. Map k a
M.empty))
             (\f :: String
f -> [String] -> String -> IO (Maybe String)
findFile ([String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ["."] (\g :: String
g -> [".", String
g]) Maybe String
mbcsldir) String
f IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                    IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CiteprocException -> IO String
forall e a. Exception e => e -> IO a
E.throwIO (CiteprocException -> IO String) -> CiteprocException -> IO String
forall a b. (a -> b) -> a -> b
$ String -> CiteprocException
CouldNotFindAbbrevFile String
f) String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return IO String -> (String -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
               String -> IO ByteString
L.readFile IO ByteString
-> (ByteString -> IO Abbreviations) -> IO Abbreviations
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
               (String -> IO Abbreviations)
-> (Abbreviations -> IO Abbreviations)
-> Either String Abbreviations
-> IO Abbreviations
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Abbreviations
forall a. HasCallStack => String -> a
error Abbreviations -> IO Abbreviations
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Abbreviations -> IO Abbreviations)
-> (ByteString -> Either String Abbreviations)
-> ByteString
-> IO Abbreviations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Abbreviations
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String Abbreviations)
-> (ByteString -> ByteString)
-> ByteString
-> Either String Abbreviations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
skipLeadingSpace)
             Maybe String
cslAbbrevFile
  let csl' :: Style
csl' = Style
csl{ styleAbbrevs :: Abbreviations
styleAbbrevs = Abbreviations
abbrevs }
  Pandoc -> IO Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> IO Pandoc) -> Pandoc -> IO Pandoc
forall a b. (a -> b) -> a -> b
$ Style -> [Reference] -> Pandoc -> Pandoc
processCites (String -> Style -> Style
forall a. String -> a -> a
tr' "CSL" Style
csl') [Reference]
refs (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks

toPath :: MetaValue -> Maybe String
toPath :: MetaValue -> Maybe String
toPath (MetaString s :: Text
s) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
-- take last in a list
toPath (MetaList xs :: [MetaValue]
xs) = case [MetaValue] -> [MetaValue]
forall a. [a] -> [a]
reverse [MetaValue]
xs of
                             []    -> Maybe String
forall a. Maybe a
Nothing
                             (x :: MetaValue
x:_) -> MetaValue -> Maybe String
toPath MetaValue
x
toPath (MetaInlines ils :: [Inline]
ils) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils
toPath _ = Maybe String
forall a. Maybe a
Nothing

getBibRefs :: (String -> Bool) -> MetaValue -> IO [Reference]
getBibRefs :: (String -> Bool) -> MetaValue -> IO [Reference]
getBibRefs idpred :: String -> Bool
idpred (MetaList xs :: [MetaValue]
xs) = [[Reference]] -> [Reference]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Reference]] -> [Reference])
-> IO [[Reference]] -> IO [Reference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (MetaValue -> IO [Reference]) -> [MetaValue] -> IO [[Reference]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> Bool) -> MetaValue -> IO [Reference]
getBibRefs String -> Bool
idpred) [MetaValue]
xs
getBibRefs idpred :: String -> Bool
idpred (MetaInlines xs :: [Inline]
xs) = (String -> Bool) -> MetaValue -> IO [Reference]
getBibRefs String -> Bool
idpred (Text -> MetaValue
MetaString (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs)
getBibRefs idpred :: String -> Bool
idpred (MetaString s :: Text
s) = do
  String
path <- [String] -> String -> IO (Maybe String)
findFile ["."] (Text -> String
T.unpack Text
s) IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CiteprocException -> IO String
forall e a. Exception e => e -> IO a
E.throwIO (CiteprocException -> IO String) -> CiteprocException -> IO String
forall a b. (a -> b) -> a -> b
$ String -> CiteprocException
CouldNotFindBibFile (String -> CiteprocException) -> String -> CiteprocException
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s) String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return
  (Reference -> Reference) -> [Reference] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map Reference -> Reference
unescapeRefId ([Reference] -> [Reference]) -> IO [Reference] -> IO [Reference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (String -> Bool) -> String -> IO [Reference]
readBiblioFile String -> Bool
idpred String
path
getBibRefs _ _ = [Reference] -> IO [Reference]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- unescape reference ids, which may contain XML entities, so
-- that we can do lookups with regular string equality
unescapeRefId :: Reference -> Reference
unescapeRefId :: Reference -> Reference
unescapeRefId ref :: Reference
ref = Reference
ref{ refId :: Literal
refId = String -> Literal
Literal (String -> Literal) -> String -> Literal
forall a b. (a -> b) -> a -> b
$ String -> String
decodeEntities (Literal -> String
unLiteral (Literal -> String) -> Literal -> String
forall a b. (a -> b) -> a -> b
$ Reference -> Literal
refId Reference
ref) }

decodeEntities :: String -> String
decodeEntities :: String -> String
decodeEntities [] = []
decodeEntities ('&':xs :: String
xs) =
  let (ys :: String
ys,zs :: String
zs) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==';') String
xs
  in  case String
zs of
           ';':ws :: String
ws -> case String -> Maybe String
lookupEntity ('&'Char -> String -> String
forall a. a -> [a] -> [a]
:String
ys String -> String -> String
forall a. [a] -> [a] -> [a]
++ ";") of
#if MIN_VERSION_tagsoup(0,13,0)
                                       Just s :: String
s  -> String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
decodeEntities String
ws
#else
                                       Just c  -> c   : decodeEntities ws
#endif
                                       Nothing -> '&' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decodeEntities String
xs
           _      -> '&' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decodeEntities String
xs
decodeEntities (x :: Char
x:xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decodeEntities String
xs

-- | Substitute 'Cite' elements with formatted citations.
processCite :: Style -> M.Map [Citation] Formatted -> Inline -> Inline
processCite :: Style -> Map [Citation] Formatted -> Inline -> Inline
processCite s :: Style
s cs :: Map [Citation] Formatted
cs (Cite t :: [Citation]
t _) =
   case [Citation] -> Map [Citation] Formatted -> Maybe Formatted
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Citation]
t Map [Citation] Formatted
cs of
        Just (Formatted xs :: [Inline]
xs)
          | Bool -> Bool
not ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
xs) Bool -> Bool -> Bool
|| (Citation -> Bool) -> [Citation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Citation -> Bool
isSuppressAuthor [Citation]
t
               -> [Citation] -> [Inline] -> Inline
Cite [Citation]
t (Style -> Formatted -> [Inline]
renderPandoc Style
s ([Inline] -> Formatted
Formatted [Inline]
xs))
        _      -> [Inline] -> Inline
Strong [Text -> Inline
Str "???"] -- TODO raise error instead?
    where isSuppressAuthor :: Citation -> Bool
isSuppressAuthor c :: Citation
c = Citation -> CitationMode
citationMode Citation
c CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
SuppressAuthor
processCite _ _ x :: Inline
x = Inline
x

getNoteCitationIds :: Inline -> [[String]]
getNoteCitationIds :: Inline -> [[String]]
getNoteCitationIds (Note [Para (Span ("",["reference-id-list"]
                                      ,[("refids",refids :: Text
refids)]) [] : _)])
  -- see deNote below which inserts this special Span
  = [String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
refids]
getNoteCitationIds (Note _) = [[]]
getNoteCitationIds _        = []

isNote :: Inline -> Bool
isNote :: Inline -> Bool
isNote (Note _)          = Bool
True
isNote (Cite _ [Note _]) = Bool
True
 -- the following allows citation styles that are "in-text" but use superscript
 -- references to be treated as if they are "notes" for the purposes of moving
 -- the citations after trailing punctuation (see <https://github.com/jgm/pandoc-citeproc/issues/382>):
isNote (Cite _ [Superscript _]) = Bool
True
isNote _                 = Bool
False

mvPunctInsideQuote :: Inline -> Inline -> [Inline]
mvPunctInsideQuote :: Inline -> Inline -> [Inline]
mvPunctInsideQuote (Quoted qt :: QuoteType
qt ils :: [Inline]
ils) (Str s :: Text
s) | Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [".", ","] =
  [QuoteType -> [Inline] -> Inline
Quoted QuoteType
qt ([Inline] -> [Inline]
forall a. [a] -> [a]
init [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ Inline -> Inline -> [Inline]
mvPunctInsideQuote ([Inline] -> Inline
forall a. [a] -> a
last [Inline]
ils) (Text -> Inline
Str Text
s))]
mvPunctInsideQuote il :: Inline
il il' :: Inline
il' = [Inline
il, Inline
il']

isSpacy :: Inline -> Bool
isSpacy :: Inline -> Bool
isSpacy Space     = Bool
True
isSpacy SoftBreak = Bool
True
isSpacy _         = Bool
False

mvPunct :: Bool -> Style -> [Inline] -> [Inline]
mvPunct :: Bool -> Style -> [Inline] -> [Inline]
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (x :: Inline
x : Space : xs :: [Inline]
xs)
  | Inline -> Bool
isSpacy Inline
x = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
xs
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (q :: Inline
q : s :: Inline
s : x :: Inline
x : ys :: [Inline]
ys)
  | Inline -> Bool
isSpacy Inline
s
  , Inline -> Bool
isNote Inline
x
  , [Inline] -> Bool
startWithPunct [Inline]
ys
  = if Bool
moveNotes
       then Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$
             case [Inline] -> String
headInline [Inline]
ys of
               "" -> Inline
q Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
tailInline [Inline]
ys
               w :: String
w  -> Inline
q Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str (String -> Text
T.pack String
w) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
tailInline [Inline]
ys
       else Inline
q Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
ys
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (Cite cs :: [Citation]
cs ils :: [Inline]
ils : ys :: [Inline]
ys)
   | [Inline] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Inline]
ils Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1
   , Inline -> Bool
isNote ([Inline] -> Inline
forall a. [a] -> a
last [Inline]
ils)
   , [Inline] -> Bool
startWithPunct [Inline]
ys
   , Bool
moveNotes
   = [Citation] -> [Inline] -> Inline
Cite [Citation]
cs
      ([Inline] -> [Inline]
forall a. [a] -> [a]
init [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++
         (case [Inline] -> String
headInline [Inline]
ys of
               "" -> []
               s' :: String
s' | Bool -> Bool
not (Bool -> [Inline] -> Bool
endWithPunct Bool
False ([Inline] -> [Inline]
forall a. [a] -> [a]
init [Inline]
ils)) -> [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s']
                  | Bool
otherwise                           -> [])
       [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Inline
forall a. [a] -> a
last [Inline]
ils]) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty ([Inline] -> [Inline]
tailInline [Inline]
ys)
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (q :: Inline
q@(Quoted _ _) : w :: Inline
w@(Str _) : x :: Inline
x : ys :: [Inline]
ys)
  | Inline -> Bool
isNote Inline
x
  , Style -> Bool
isPunctuationInQuote Style
sty
  , Bool
moveNotes
  = Inline -> Inline -> [Inline]
mvPunctInsideQuote Inline
q Inline
w [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ (Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
ys)
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (s :: Inline
s : x :: Inline
x : ys :: [Inline]
ys) | Inline -> Bool
isSpacy Inline
s, Inline -> Bool
isNote Inline
x =
  Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
ys
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (s :: Inline
s : x :: Inline
x@(Cite _ (Superscript _ : _)) : ys :: [Inline]
ys)
  | Inline -> Bool
isSpacy Inline
s = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
ys
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (Cite cs :: [Citation]
cs ils :: [Inline]
ils : Str "." : ys :: [Inline]
ys)
  | [Inline] -> String
lastInline [Inline]
ils String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "."
  = [Citation] -> [Inline] -> Inline
Cite [Citation]
cs [Inline]
ils Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
ys
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (x :: Inline
x:xs :: [Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
xs
mvPunct _ _ [] = []

endWithPunct :: Bool -> [Inline] -> Bool
endWithPunct :: Bool -> [Inline] -> Bool
endWithPunct _ [] = Bool
True
endWithPunct onlyFinal :: Bool
onlyFinal xs :: [Inline]
xs@(_:_) =
  case String -> String
forall a. [a] -> [a]
reverse (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs) of
       []                       -> Bool
True
       -- covers .), .", etc.:
       (d :: Char
d:c :: Char
c:_) | Char -> Bool
isPunctuation Char
d
                 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
onlyFinal
                 Bool -> Bool -> Bool
&& Char -> Bool
isEndPunct Char
c -> Bool
True
       (c :: Char
c:_) | Char -> Bool
isEndPunct Char
c      -> Bool
True
             | Bool
otherwise         -> Bool
False
  where isEndPunct :: Char -> Bool
isEndPunct c :: Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (".,;:!?" :: String)

startWithPunct :: [Inline] -> Bool
startWithPunct :: [Inline] -> Bool
startWithPunct = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (".,;:!?" :: String)) (String -> Bool) -> ([Inline] -> String) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> String
headInline

deNote :: Pandoc -> Pandoc
deNote :: Pandoc -> Pandoc
deNote = (Inline -> Inline) -> Pandoc -> Pandoc
forall a b. (Data a, Data b) => (a -> a) -> b -> b
topDown Inline -> Inline
go
  where go :: Inline -> Inline
go (Cite (c :: Citation
c:cs :: [Citation]
cs) [Note [Para xs :: [Inline]
xs]]) =
            [Citation] -> [Inline] -> Inline
Cite (Citation
cCitation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
cs) [[Block] -> Inline
Note [[Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ [Citation] -> Inline
specialSpan (Citation
cCitation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
cs) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
toCapital [Inline]
xs]]
        go (Note xs :: [Block]
xs) = [Block] -> Inline
Note ([Block] -> Inline) -> [Block] -> Inline
forall a b. (a -> b) -> a -> b
$ ([Inline] -> [Inline]) -> [Block] -> [Block]
forall a b. (Data a, Data b) => (a -> a) -> b -> b
topDown [Inline] -> [Inline]
go' [Block]
xs
        go x :: Inline
x = Inline
x
        -- we insert this to help getNoteCitationIds:
        specialSpan :: [Citation] -> Inline
specialSpan cs :: [Citation]
cs =
          Attr -> [Inline] -> Inline
Span ("",["reference-id-list"],
            [("refids", [Text] -> Text
T.unwords ((Citation -> Text) -> [Citation] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Citation -> Text
citationId [Citation]
cs))]) []
        go' :: [Inline] -> [Inline]
go' (Str "(" : Cite cs :: [Citation]
cs [Note [Para xs :: [Inline]
xs]] : Str ")" : ys :: [Inline]
ys) =
             Text -> Inline
Str "(" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Citation] -> [Inline] -> Inline
Cite [Citation]
cs [Inline]
xs Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str ")" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ys
        go' (x :: Inline
x : Cite cs :: [Citation]
cs [Note [Para xs :: [Inline]
xs]] : ys :: [Inline]
ys) | Bool -> Bool
not (Inline -> Bool
isSpacy Inline
x) =
             Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str "," Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: ([Inline] -> [Inline]) -> [Inline] -> [Inline] -> [Inline]
comb (\zs :: [Inline]
zs -> [[Citation] -> [Inline] -> Inline
Cite [Citation]
cs [Inline]
zs]) [Inline]
xs [Inline]
ys
        go' (Str "(" : Note [Para xs :: [Inline]
xs] : Str ")" : ys :: [Inline]
ys) =
             Text -> Inline
Str "(" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ (Text -> Inline
Str ")" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ys)
        go' (x :: Inline
x : Note [Para xs :: [Inline]
xs] : ys :: [Inline]
ys) | Bool -> Bool
not (Inline -> Bool
isSpacy Inline
x) =
             Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str "," Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: ([Inline] -> [Inline]) -> [Inline] -> [Inline] -> [Inline]
comb [Inline] -> [Inline]
forall a. a -> a
id [Inline]
xs [Inline]
ys
        go' (Cite cs :: [Citation]
cs [Note [Para xs :: [Inline]
xs]] : ys :: [Inline]
ys) = ([Inline] -> [Inline]) -> [Inline] -> [Inline] -> [Inline]
comb (\zs :: [Inline]
zs -> [[Citation] -> [Inline] -> Inline
Cite [Citation]
cs [Inline]
zs]) [Inline]
xs [Inline]
ys
        go' (Note [Para xs :: [Inline]
xs] : ys :: [Inline]
ys) = ([Inline] -> [Inline]) -> [Inline] -> [Inline] -> [Inline]
comb [Inline] -> [Inline]
forall a. a -> a
id [Inline]
xs [Inline]
ys
        go' xs :: [Inline]
xs = [Inline]
xs

comb :: ([Inline] -> [Inline]) -> [Inline] -> [Inline] -> [Inline]
comb :: ([Inline] -> [Inline]) -> [Inline] -> [Inline] -> [Inline]
comb f :: [Inline] -> [Inline]
f xs :: [Inline]
xs ys :: [Inline]
ys =
  let xs' :: [Inline]
xs' = if [Inline] -> Bool
startWithPunct [Inline]
ys Bool -> Bool -> Bool
&& Bool -> [Inline] -> Bool
endWithPunct Bool
True [Inline]
xs
               then [Inline] -> [Inline]
initInline ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
removeLeadingPunct [Inline]
xs
               else [Inline] -> [Inline]
removeLeadingPunct [Inline]
xs
      removeLeadingPunct :: [Inline] -> [Inline]
removeLeadingPunct (Str (Text -> String
T.unpack -> [c :: Char
c]) : s :: Inline
s : zs :: [Inline]
zs)
          | Inline -> Bool
isSpacy Inline
s Bool -> Bool -> Bool
&& (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ':') = [Inline]
zs
      removeLeadingPunct zs :: [Inline]
zs = [Inline]
zs
  in  [Inline] -> [Inline]
f [Inline]
xs' [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
ys

-- | Retrieve all citations from a 'Pandoc' document. To be used with
-- 'query'.
getCitation :: Inline -> [[Citation]]
getCitation :: Inline -> [[Citation]]
getCitation i :: Inline
i | Cite t :: [Citation]
t _ <- Inline
i = [[Citation]
t]
              | Bool
otherwise     = []

getCitationIds :: Inline -> Set.Set String
getCitationIds :: Inline -> Set String
getCitationIds (Cite cs :: [Citation]
cs _) = (Text -> String) -> Set Text -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> String
T.unpack (Set Text -> Set String) -> Set Text -> Set String
forall a b. (a -> b) -> a -> b
$ [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ((Citation -> Text) -> [Citation] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Citation -> Text
citationId [Citation]
cs)
getCitationIds _ = Set String
forall a. Monoid a => a
mempty

setHashes :: Inline -> State Int Inline
setHashes :: Inline -> StateT Int Identity Inline
setHashes i :: Inline
i | Cite t :: [Citation]
t ils :: [Inline]
ils <- Inline
i = do [Citation]
t' <- (Citation -> StateT Int Identity Citation)
-> [Citation] -> StateT Int Identity [Citation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Citation -> StateT Int Identity Citation
setHash [Citation]
t
                                   Inline -> StateT Int Identity Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> StateT Int Identity Inline)
-> Inline -> StateT Int Identity Inline
forall a b. (a -> b) -> a -> b
$ [Citation] -> [Inline] -> Inline
Cite [Citation]
t' [Inline]
ils
            | Bool
otherwise       = Inline -> StateT Int Identity Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
i

setHash :: Citation -> State Int Citation
setHash :: Citation -> StateT Int Identity Citation
setHash c :: Citation
c = do
  Int
ident <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
  Int -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> StateT Int Identity ()) -> Int -> StateT Int Identity ()
forall a b. (a -> b) -> a -> b
$ Int
ident Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
  Citation -> StateT Int Identity Citation
forall (m :: * -> *) a. Monad m => a -> m a
return Citation
c{ citationHash :: Int
citationHash = Int
ident }

toCslCite :: LocatorMap -> Citation -> CSL.Cite
toCslCite :: LocatorMap -> Citation -> Cite
toCslCite locMap :: LocatorMap
locMap c :: Citation
c
    = let (la :: String
la, lo :: String
lo, s :: [Inline]
s)  = LocatorMap -> [Inline] -> (String, String, [Inline])
locatorWords LocatorMap
locMap ([Inline] -> (String, String, [Inline]))
-> [Inline] -> (String, String, [Inline])
forall a b. (a -> b) -> a -> b
$ Citation -> [Inline]
citationSuffix Citation
c
          s' :: [Inline]
s'      = case (String
la,String
lo,[Inline]
s) of
                         -- treat a bare locator as if it begins with space
                         -- so @item1 [blah] is like [@item1, blah]
                         ("","",x :: Inline
x:_)
                           | Bool -> Bool
not (Inline -> Bool
isPunct Inline
x) -> Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
s
                         _                   -> [Inline]
s
          isPunct :: Inline -> Bool
isPunct (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (x :: Char
x,_))) = Char -> Bool
isPunctuation Char
x
          isPunct _           = Bool
False
      in   Cite
emptyCite { citeId :: String
CSL.citeId         = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Citation -> Text
citationId Citation
c
                     , citePrefix :: Formatted
CSL.citePrefix     = [Inline] -> Formatted
Formatted ([Inline] -> Formatted) -> [Inline] -> Formatted
forall a b. (a -> b) -> a -> b
$ Citation -> [Inline]
citationPrefix Citation
c
                     , citeSuffix :: Formatted
CSL.citeSuffix     = [Inline] -> Formatted
Formatted [Inline]
s'
                     , citeLabel :: String
CSL.citeLabel      = String
la
                     , citeLocator :: String
CSL.citeLocator    = String
lo
                     , citeNoteNumber :: String
CSL.citeNoteNumber = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Citation -> Int
citationNoteNum Citation
c
                     , authorInText :: Bool
CSL.authorInText   = Citation -> CitationMode
citationMode Citation
c CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
AuthorInText
                     , suppressAuthor :: Bool
CSL.suppressAuthor = Citation -> CitationMode
citationMode Citation
c CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
SuppressAuthor
                     , citeHash :: Int
CSL.citeHash       = Citation -> Int
citationHash Citation
c
                     }

splitInp :: [Inline] -> [Inline]
splitInp :: [Inline] -> [Inline]
splitInp = (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen (\c :: Char
c -> Char -> Bool
splitOn Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c)
  where
      splitOn :: Char -> Bool
splitOn ':' = Bool
False
      splitOn c :: Char
c   = Char -> Bool
isPunctuation Char
c

locatorWords :: LocatorMap -> [Inline] -> (String, String, [Inline])
locatorWords :: LocatorMap -> [Inline] -> (String, String, [Inline])
locatorWords locMap :: LocatorMap
locMap inp :: [Inline]
inp =
  case Parsec [Inline] () (String, String, [Inline])
-> String
-> [Inline]
-> Either ParseError (String, String, [Inline])
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (LocatorMap -> Parsec [Inline] () (String, String, [Inline])
forall st.
LocatorMap -> Parsec [Inline] st (String, String, [Inline])
pLocatorWords LocatorMap
locMap) "suffix" ([Inline] -> Either ParseError (String, String, [Inline]))
-> [Inline] -> Either ParseError (String, String, [Inline])
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
splitInp [Inline]
inp of
       Right r :: (String, String, [Inline])
r -> (String, String, [Inline])
r
       Left _  -> ("","",[Inline]
inp)

-- Some terminology
-- ----------------
-- Word       => 89
--               12-15
--               13(a)(i)-(iv)
--               [1.2.5]
--
-- Integrated => [@citekey, 89]
--               [@citekey, p. 40, 41, 89-199, suffix]
-- Delimited  => [@citekey{89}]
--               [@citekey, {p. literally anything except unbalanced curly quotes}, suffix]
--
-- When parsing integrated locators you have to be careful not to include
-- 'suffix' in the locator, so that means pretty strict control over when
-- you're allowed to use NO digits in a word. [@citekey, p. 40(a) (bcd)] will
-- stop parsing the locator after (a). You also have to be careful not to parse
-- random terms like 'and' in en-US as citeLabels, which means careful control
-- over what must come directly after any label string (via notFollowedBy).
--
-- With delimited locators, it's a different story. Parse as long a locator
-- label as you can find in the terms map, then include EVERYTHING in the outer
-- {} braces.
--
-- Ultimately the complexity is driven by wanting as many locator words as
-- possible being parsed in the integrated style, because it fits with the
-- aims of Markdown (being readable). Ideally, anything except a word with
-- neither roman numerals nor arabic digits can be integrated. Some
-- counter-examples:
-- a
-- (a)(b)(c)
-- (hello)

pLocatorWords :: LocatorMap -> Parsec [Inline] st (String, String, [Inline])
pLocatorWords :: LocatorMap -> Parsec [Inline] st (String, String, [Inline])
pLocatorWords locMap :: LocatorMap
locMap = do
  ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT [Inline] st Identity Inline
 -> ParsecT [Inline] st Identity ())
-> ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity ()
forall a b. (a -> b) -> a -> b
$ String -> (Char -> Bool) -> ParsecT [Inline] st Identity Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar "," (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',')
  ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Inline] st Identity Inline
forall st. Parsec [Inline] st Inline
pSpace
  (la :: String
la, lo :: String
lo) <- LocatorMap -> Parsec [Inline] st (String, String)
forall st. LocatorMap -> Parsec [Inline] st (String, String)
pLocatorDelimited LocatorMap
locMap Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LocatorMap -> Parsec [Inline] st (String, String)
forall st. LocatorMap -> Parsec [Inline] st (String, String)
pLocatorIntegrated LocatorMap
locMap
  [Inline]
s <- ParsecT [Inline] st Identity [Inline]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput -- rest is suffix
  -- need to trim, otherwise "p. 9" and "9" will have 'different' locators later on
  -- i.e. the first one will be " 9"
  (String, String, [Inline])
-> Parsec [Inline] st (String, String, [Inline])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
la, String -> String
trim String
lo, [Inline]
s)

pLocatorDelimited :: LocatorMap -> Parsec [Inline] st (String, String)
pLocatorDelimited :: LocatorMap -> Parsec [Inline] st (String, String)
pLocatorDelimited locMap :: LocatorMap
locMap = Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (String, String)
 -> Parsec [Inline] st (String, String))
-> Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String)
forall a b. (a -> b) -> a -> b
$ do
  Inline
_ <- String -> (Char -> Bool) -> Parsec [Inline] st Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar "{" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '{')
  Parsec [Inline] st Inline -> ParsecT [Inline] st Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany Parsec [Inline] st Inline
forall st. Parsec [Inline] st Inline
pSpace -- gobble pre-spaces so label doesn't try to include them
  (la :: String
la, _) <- LocatorMap -> Parsec [Inline] st (String, Bool)
forall st. LocatorMap -> Parsec [Inline] st (String, Bool)
pLocatorLabelDelimited LocatorMap
locMap
  -- we only care about balancing {} and [] (because of the outer [] scope);
  -- the rest can be anything
  let inner :: ParsecT [Inline] u Identity (Bool, String)
inner = do { Inline
t <- ParsecT [Inline] u Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken; (Bool, String) -> ParsecT [Inline] u Identity (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify Inline
t) }
  [(Bool, String)]
gs <- ParsecT [Inline] st Identity (Bool, String)
-> ParsecT [Inline] st Identity [(Bool, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([(Char, Char)]
-> ParsecT [Inline] st Identity (Bool, String)
-> ParsecT [Inline] st Identity (Bool, String)
forall st.
[(Char, Char)]
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
pBalancedBraces [('{','}'), ('[',']')] ParsecT [Inline] st Identity (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
inner)
  Inline
_ <- String -> (Char -> Bool) -> Parsec [Inline] st Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar "}" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '}')
  let lo :: String
lo = ((Bool, String) -> String) -> [(Bool, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool, String) -> String
forall a b. (a, b) -> b
snd [(Bool, String)]
gs
  (String, String) -> Parsec [Inline] st (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
la, String
lo)

pLocatorLabelDelimited :: LocatorMap -> Parsec [Inline] st (String, Bool)
pLocatorLabelDelimited :: LocatorMap -> Parsec [Inline] st (String, Bool)
pLocatorLabelDelimited locMap :: LocatorMap
locMap
  = LocatorMap
-> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)
forall st.
LocatorMap
-> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)
pLocatorLabel' LocatorMap
locMap Parsec [Inline] st String
forall u. ParsecT [Inline] u Identity String
lim Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String, Bool) -> Parsec [Inline] st (String, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ("page", Bool
True)
    where
        lim :: ParsecT [Inline] u Identity String
lim = Text -> String
T.unpack (Text -> String) -> (Inline -> Text) -> Inline -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline -> String)
-> ParsecT [Inline] u Identity Inline
-> ParsecT [Inline] u Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Inline] u Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken

pLocatorIntegrated :: LocatorMap -> Parsec [Inline] st (String, String)
pLocatorIntegrated :: LocatorMap -> Parsec [Inline] st (String, String)
pLocatorIntegrated locMap :: LocatorMap
locMap = Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (String, String)
 -> Parsec [Inline] st (String, String))
-> Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String)
forall a b. (a -> b) -> a -> b
$ do
  (la :: String
la, wasImplicit :: Bool
wasImplicit) <- LocatorMap -> Parsec [Inline] st (String, Bool)
forall st. LocatorMap -> Parsec [Inline] st (String, Bool)
pLocatorLabelIntegrated LocatorMap
locMap
  -- if we got the label implicitly, we have presupposed the first one is going
  -- to have a digit, so guarantee that. You _can_ have p. (a) because you
  -- specified it.
  let modifier :: (Bool, String) -> Parsec [Inline] st String
modifier = if Bool
wasImplicit
                    then (Bool, String) -> Parsec [Inline] st String
forall st. (Bool, String) -> Parsec [Inline] st String
requireDigits
                    else (Bool, String) -> Parsec [Inline] st String
forall st. (Bool, String) -> Parsec [Inline] st String
requireRomansOrDigits
  String
g <- ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] st Identity String
 -> ParsecT [Inline] st Identity String)
-> ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String
forall a b. (a -> b) -> a -> b
$ Bool -> Parsec [Inline] st (Bool, String)
forall st. Bool -> Parsec [Inline] st (Bool, String)
pLocatorWordIntegrated (Bool -> Bool
not Bool
wasImplicit) Parsec [Inline] st (Bool, String)
-> ((Bool, String) -> ParsecT [Inline] st Identity String)
-> ParsecT [Inline] st Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, String) -> ParsecT [Inline] st Identity String
forall st. (Bool, String) -> Parsec [Inline] st String
modifier
  [String]
gs <- ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] st Identity String
 -> ParsecT [Inline] st Identity String)
-> ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String
forall a b. (a -> b) -> a -> b
$ Bool -> Parsec [Inline] st (Bool, String)
forall st. Bool -> Parsec [Inline] st (Bool, String)
pLocatorWordIntegrated Bool
False Parsec [Inline] st (Bool, String)
-> ((Bool, String) -> ParsecT [Inline] st Identity String)
-> ParsecT [Inline] st Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, String) -> ParsecT [Inline] st Identity String
forall st. (Bool, String) -> Parsec [Inline] st String
modifier)
  let lo :: String
lo = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String
gString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
gs)
  (String, String) -> Parsec [Inline] st (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
la, String
lo)

pLocatorLabelIntegrated :: LocatorMap -> Parsec [Inline] st (String, Bool)
pLocatorLabelIntegrated :: LocatorMap -> Parsec [Inline] st (String, Bool)
pLocatorLabelIntegrated locMap :: LocatorMap
locMap
  = LocatorMap
-> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)
forall st.
LocatorMap
-> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)
pLocatorLabel' LocatorMap
locMap Parsec [Inline] st String
forall u. ParsecT [Inline] u Identity String
lim Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parsec [Inline] st String -> Parsec [Inline] st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead Parsec [Inline] st String
forall u. ParsecT [Inline] u Identity String
digital Parsec [Inline] st String
-> Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String, Bool) -> Parsec [Inline] st (String, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ("page", Bool
True))
    where
      lim :: ParsecT [Inline] u Identity String
lim = ParsecT [Inline] u Identity String
-> ParsecT [Inline] u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] u Identity String
 -> ParsecT [Inline] u Identity String)
-> ParsecT [Inline] u Identity String
-> ParsecT [Inline] u Identity String
forall a b. (a -> b) -> a -> b
$ Bool -> Parsec [Inline] u (Bool, String)
forall st. Bool -> Parsec [Inline] st (Bool, String)
pLocatorWordIntegrated Bool
True Parsec [Inline] u (Bool, String)
-> ((Bool, String) -> ParsecT [Inline] u Identity String)
-> ParsecT [Inline] u Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, String) -> ParsecT [Inline] u Identity String
forall st. (Bool, String) -> Parsec [Inline] st String
requireRomansOrDigits
      digital :: ParsecT [Inline] u Identity String
digital = ParsecT [Inline] u Identity String
-> ParsecT [Inline] u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] u Identity String
 -> ParsecT [Inline] u Identity String)
-> ParsecT [Inline] u Identity String
-> ParsecT [Inline] u Identity String
forall a b. (a -> b) -> a -> b
$ Bool -> Parsec [Inline] u (Bool, String)
forall st. Bool -> Parsec [Inline] st (Bool, String)
pLocatorWordIntegrated Bool
True Parsec [Inline] u (Bool, String)
-> ((Bool, String) -> ParsecT [Inline] u Identity String)
-> ParsecT [Inline] u Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, String) -> ParsecT [Inline] u Identity String
forall st. (Bool, String) -> Parsec [Inline] st String
requireDigits

pLocatorLabel' :: LocatorMap -> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)
pLocatorLabel' :: LocatorMap
-> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)
pLocatorLabel' locMap :: LocatorMap
locMap lim :: Parsec [Inline] st String
lim = String -> Parsec [Inline] st (String, Bool)
go ""
    where
      -- grow the match string until we hit the end
      -- trying to find the largest match for a label
      go :: String -> Parsec [Inline] st (String, Bool)
go acc :: String
acc = Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (String, Bool)
 -> Parsec [Inline] st (String, Bool))
-> Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
forall a b. (a -> b) -> a -> b
$ do
          -- advance at least one token each time
          -- the pathological case is "p.3"
          Inline
t <- ParsecT [Inline] st Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
          [Inline]
ts <- ParsecT [Inline] st Identity Inline
-> Parsec [Inline] st String
-> ParsecT [Inline] st Identity [Inline]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [Inline] st Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken (Parsec [Inline] st String -> Parsec [Inline] st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st String -> Parsec [Inline] st String)
-> Parsec [Inline] st String -> Parsec [Inline] st String
forall a b. (a -> b) -> a -> b
$ Parsec [Inline] st String -> Parsec [Inline] st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead Parsec [Inline] st String
lim)
          let s :: String
s = String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline
tInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ts))
          case String -> LocatorMap -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> String
trim String
s) LocatorMap
locMap of
            -- try to find a longer one, or return this one
            Just l :: String
l -> String -> Parsec [Inline] st (String, Bool)
go String
s Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String, Bool) -> Parsec [Inline] st (String, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
l, Bool
False)
            Nothing -> String -> Parsec [Inline] st (String, Bool)
go String
s

-- hard requirement for a locator to have some real digits in it
requireDigits :: (Bool, String) -> Parsec [Inline] st String
requireDigits :: (Bool, String) -> Parsec [Inline] st String
requireDigits (_, s :: String
s) = if Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isDigit String
s)
                          then String -> Parsec [Inline] st String
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail "requireDigits"
                          else String -> Parsec [Inline] st String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s

-- soft requirement for a sequence with some roman or arabic parts
-- (a)(iv) -- because iv is roman
-- 1(a)  -- because 1 is an actual digit
-- NOT: a, (a)-(b), hello, (some text in brackets)
requireRomansOrDigits :: (Bool, String) -> Parsec [Inline] st String
requireRomansOrDigits :: (Bool, String) -> Parsec [Inline] st String
requireRomansOrDigits (d :: Bool
d, s :: String
s) = if Bool -> Bool
not Bool
d
                                  then String -> Parsec [Inline] st String
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail "requireRomansOrDigits"
                                  else String -> Parsec [Inline] st String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s

pLocatorWordIntegrated :: Bool -> Parsec [Inline] st (Bool, String)
pLocatorWordIntegrated :: Bool -> Parsec [Inline] st (Bool, String)
pLocatorWordIntegrated isFirst :: Bool
isFirst = Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (Bool, String)
 -> Parsec [Inline] st (Bool, String))
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall a b. (a -> b) -> a -> b
$ do
  Text
punct <- if Bool
isFirst
              then Text -> ParsecT [Inline] st Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return ""
              else (Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline -> Text)
-> ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Inline] st Identity Inline
forall st. Parsec [Inline] st Inline
pLocatorSep) ParsecT [Inline] st Identity Text
-> ParsecT [Inline] st Identity Text
-> ParsecT [Inline] st Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ParsecT [Inline] st Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return ""
  String
sp <- String
-> ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (ParsecT [Inline] st Identity Inline
forall st. Parsec [Inline] st Inline
pSpace ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT [Inline] st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return " ")
  (dig :: Bool
dig, s :: String
s) <- [(Char, Char)]
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall st.
[(Char, Char)]
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
pBalancedBraces [('(',')'), ('[',']'), ('{','}')] Parsec [Inline] st (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
pPageSeq
  (Bool, String) -> Parsec [Inline] st (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
dig, Text -> String
T.unpack Text
punct String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)

-- we want to capture:  123, 123A, C22, XVII, 33-44, 22-33; 22-11
--                      34(1), 34A(A), 34(1)(i)(i), (1)(a)
--                      [17], [17]-[18], '591 [84]'
--                      (because CSL cannot pull out individual pages/sections
--                      to wrap in braces on a per-style basis)
pBalancedBraces :: [(Char, Char)] -> Parsec [Inline] st (Bool, String) -> Parsec [Inline] st (Bool, String)
pBalancedBraces :: [(Char, Char)]
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
pBalancedBraces braces :: [(Char, Char)]
braces p :: Parsec [Inline] st (Bool, String)
p = Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (Bool, String)
 -> Parsec [Inline] st (Bool, String))
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall a b. (a -> b) -> a -> b
$ do
  [(Bool, String)]
ss <- Parsec [Inline] st (Bool, String)
-> ParsecT [Inline] st Identity [(Bool, String)]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 Parsec [Inline] st (Bool, String)
surround
  (Bool, String) -> Parsec [Inline] st (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, String) -> Parsec [Inline] st (Bool, String))
-> (Bool, String) -> Parsec [Inline] st (Bool, String)
forall a b. (a -> b) -> a -> b
$ [(Bool, String)] -> (Bool, String)
anyWereDigitLike [(Bool, String)]
ss
  where
      except :: Parsec [Inline] st (Bool, String)
except = ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Inline] st Identity Inline
forall st. Parsec [Inline] st Inline
pBraces ParsecT [Inline] st Identity ()
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parsec [Inline] st (Bool, String)
p
      -- outer and inner
      surround :: Parsec [Inline] st (Bool, String)
surround = (Parsec [Inline] st (Bool, String)
 -> (Char, Char) -> Parsec [Inline] st (Bool, String))
-> Parsec [Inline] st (Bool, String)
-> [(Char, Char)]
-> Parsec [Inline] st (Bool, String)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a :: Parsec [Inline] st (Bool, String)
a (open :: Char
open, close :: Char
close) -> Char
-> Char
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall u.
Char
-> Char
-> ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
sur Char
open Char
close Parsec [Inline] st (Bool, String)
except Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec [Inline] st (Bool, String)
a) Parsec [Inline] st (Bool, String)
except [(Char, Char)]
braces

      isc :: Char -> ParsecT [Inline] st Identity Text
isc c :: Char
c = Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline -> Text)
-> ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (Char -> Bool) -> ParsecT [Inline] st Identity Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar [Char
c] (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)

      sur :: Char
-> Char
-> ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
sur c :: Char
c c' :: Char
c' m :: ParsecT [Inline] u Identity (Bool, String)
m = ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] u Identity (Bool, String)
 -> ParsecT [Inline] u Identity (Bool, String))
-> ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall a b. (a -> b) -> a -> b
$ do
          (d :: Bool
d, mid :: String
mid) <- ParsecT [Inline] u Identity Text
-> ParsecT [Inline] u Identity Text
-> ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT [Inline] u Identity Text
forall st. Char -> ParsecT [Inline] st Identity Text
isc Char
c) (Char -> ParsecT [Inline] u Identity Text
forall st. Char -> ParsecT [Inline] st Identity Text
isc Char
c') ((Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Bool
False, "") ParsecT [Inline] u Identity (Bool, String)
m)
          (Bool, String) -> ParsecT [Inline] u Identity (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
d, [Char
c] String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
mid String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c'])

      flattened :: String
flattened = ((Char, Char) -> String) -> [(Char, Char)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(o :: Char
o, c :: Char
c) -> [Char
o, Char
c]) [(Char, Char)]
braces
      pBraces :: Parsec [Inline] st Inline
pBraces = String -> (Char -> Bool) -> Parsec [Inline] st Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar "braces" (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
flattened)

-- YES 1, 1.2, 1.2.3
-- NO  1., 1.2. a.6
-- can't use sepBy because we want to leave trailing .s
pPageSeq :: Parsec [Inline] st (Bool, String)
pPageSeq :: Parsec [Inline] st (Bool, String)
pPageSeq = Parsec [Inline] st (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
oneDotTwo Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec [Inline] st (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
withPeriod
  where
      oneDotTwo :: ParsecT [Inline] st Identity (Bool, String)
oneDotTwo = do
          (Bool, String)
u <- ParsecT [Inline] st Identity (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
pPageUnit
          [(Bool, String)]
us <- ParsecT [Inline] st Identity (Bool, String)
-> ParsecT [Inline] st Identity [(Bool, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Inline] st Identity (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
withPeriod
          (Bool, String) -> ParsecT [Inline] st Identity (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, String) -> ParsecT [Inline] st Identity (Bool, String))
-> (Bool, String) -> ParsecT [Inline] st Identity (Bool, String)
forall a b. (a -> b) -> a -> b
$ [(Bool, String)] -> (Bool, String)
anyWereDigitLike ((Bool, String)
u(Bool, String) -> [(Bool, String)] -> [(Bool, String)]
forall a. a -> [a] -> [a]
:[(Bool, String)]
us)
      withPeriod :: ParsecT [Inline] u Identity (Bool, String)
withPeriod = ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] u Identity (Bool, String)
 -> ParsecT [Inline] u Identity (Bool, String))
-> ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall a b. (a -> b) -> a -> b
$ do
          -- .2
          Inline
p <- String -> (Char -> Bool) -> Parsec [Inline] u Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar "." (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.')
          (Bool, String)
u <- ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT [Inline] u Identity (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
pPageUnit
          (Bool, String) -> ParsecT [Inline] u Identity (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, String) -> Bool
forall a b. (a, b) -> a
fst (Bool, String)
u, Text -> String
T.unpack (Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify Inline
p) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Bool, String) -> String
forall a b. (a, b) -> b
snd (Bool, String)
u)

anyWereDigitLike :: [(Bool, String)] -> (Bool, String)
anyWereDigitLike :: [(Bool, String)] -> (Bool, String)
anyWereDigitLike as :: [(Bool, String)]
as = (((Bool, String) -> Bool) -> [(Bool, String)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool, String) -> Bool
forall a b. (a, b) -> a
fst [(Bool, String)]
as, ((Bool, String) -> String) -> [(Bool, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool, String) -> String
forall a b. (a, b) -> b
snd [(Bool, String)]
as)

pPageUnit :: Parsec [Inline] st (Bool, String)
pPageUnit :: Parsec [Inline] st (Bool, String)
pPageUnit = Parsec [Inline] st (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
roman Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec [Inline] st (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
plainUnit
  where
      -- roman is a 'digit'
      roman :: ParsecT [Inline] st Identity (Bool, String)
roman = (Bool
True,) (String -> (Bool, String))
-> ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity (Bool, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Inline] st Identity String
forall u. ParsecT [Inline] u Identity String
pRoman
      plainUnit :: ParsecT [Inline] u Identity (Bool, String)
plainUnit = do
          [Inline]
ts <- ParsecT [Inline] u Identity Inline
-> ParsecT [Inline] u Identity [Inline]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Inline] u Identity Inline
-> ParsecT [Inline] u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Inline] u Identity Inline
forall st. Parsec [Inline] st Inline
pSpace ParsecT [Inline] u Identity ()
-> ParsecT [Inline] u Identity () -> ParsecT [Inline] u Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       ParsecT [Inline] u Identity Inline
-> ParsecT [Inline] u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Inline] u Identity Inline
forall st. Parsec [Inline] st Inline
pLocatorPunct ParsecT [Inline] u Identity ()
-> ParsecT [Inline] u Identity Inline
-> ParsecT [Inline] u Identity Inline
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       ParsecT [Inline] u Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken)
          let s :: String
s = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ts
          -- otherwise look for actual digits or -s
          (Bool, String) -> ParsecT [Inline] u Identity (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isDigit String
s, String
s)

pRoman :: Parsec [Inline] st String
pRoman :: Parsec [Inline] st String
pRoman = Parsec [Inline] st String -> Parsec [Inline] st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st String -> Parsec [Inline] st String)
-> Parsec [Inline] st String -> Parsec [Inline] st String
forall a b. (a -> b) -> a -> b
$ do
  Inline
t <- ParsecT [Inline] st Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
  case Inline
t of
       Str xs :: Text
xs -> case String -> Maybe Int
parseRomanNumeral (Text -> String
T.unpack Text
xs) of
                      Nothing -> Parsec [Inline] st String
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                      Just _  -> String -> Parsec [Inline] st String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parsec [Inline] st String)
-> String -> Parsec [Inline] st String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
xs
       _      -> Parsec [Inline] st String
forall (m :: * -> *) a. MonadPlus m => m a
mzero

isLocatorPunct :: Char -> Bool
isLocatorPunct :: Char -> Bool
isLocatorPunct '-' = Bool
False -- page range
isLocatorPunct '–' = Bool
False -- page range, en dash
isLocatorPunct ':' = Bool
False -- vol:page-range hack
isLocatorPunct c :: Char
c   = Char -> Bool
isPunctuation Char
c -- includes [{()}]

pLocatorPunct :: Parsec [Inline] st Inline
pLocatorPunct :: Parsec [Inline] st Inline
pLocatorPunct = String -> (Char -> Bool) -> Parsec [Inline] st Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar "punctuation" Char -> Bool
isLocatorPunct

pLocatorSep :: Parsec [Inline] st Inline
pLocatorSep :: Parsec [Inline] st Inline
pLocatorSep = String -> (Char -> Bool) -> Parsec [Inline] st Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar "locator separator" Char -> Bool
isLocatorSep

isLocatorSep :: Char -> Bool
isLocatorSep :: Char -> Bool
isLocatorSep ',' = Bool
True
isLocatorSep ';' = Bool
True
isLocatorSep _   = Bool
False

pMatchChar :: String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar :: String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar msg :: String
msg f :: Char -> Bool
f = String -> (Inline -> Bool) -> Parsec [Inline] st Inline
forall st. String -> (Inline -> Bool) -> Parsec [Inline] st Inline
pMatch String
msg Inline -> Bool
mc
    where
        mc :: Inline -> Bool
mc (Str (Text -> String
T.unpack -> [c :: Char
c])) = Char -> Bool
f Char
c
        mc _         = Bool
False

pSpace :: Parsec [Inline] st Inline
pSpace :: Parsec [Inline] st Inline
pSpace = String -> (Inline -> Bool) -> Parsec [Inline] st Inline
forall st. String -> (Inline -> Bool) -> Parsec [Inline] st Inline
pMatch "' '" (\t :: Inline
t -> Inline -> Bool
isSpacy Inline
t Bool -> Bool -> Bool
|| Inline
t Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Inline
Str "\160")

pMatch :: String -> (Inline -> Bool) -> Parsec [Inline] st Inline
pMatch :: String -> (Inline -> Bool) -> Parsec [Inline] st Inline
pMatch msg :: String
msg condition :: Inline -> Bool
condition = Parsec [Inline] st Inline -> Parsec [Inline] st Inline
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st Inline -> Parsec [Inline] st Inline)
-> Parsec [Inline] st Inline -> Parsec [Inline] st Inline
forall a b. (a -> b) -> a -> b
$ do
  Inline
t <- Parsec [Inline] st Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
  if Bool -> Bool
not (Inline -> Bool
condition Inline
t)
     then String -> Parsec [Inline] st Inline
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
msg
     else Inline -> Parsec [Inline] st Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
t

type LocatorMap = M.Map String String

locatorMap :: Style -> LocatorMap
locatorMap :: Style -> LocatorMap
locatorMap sty :: Style
sty =
  (CslTerm -> LocatorMap -> LocatorMap)
-> LocatorMap -> [CslTerm] -> LocatorMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\term :: CslTerm
term -> String -> String -> LocatorMap -> LocatorMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (CslTerm -> String
termSingular CslTerm
term) (CslTerm -> String
cslTerm CslTerm
term)
                (LocatorMap -> LocatorMap)
-> (LocatorMap -> LocatorMap) -> LocatorMap -> LocatorMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> LocatorMap -> LocatorMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (CslTerm -> String
termPlural CslTerm
term) (CslTerm -> String
cslTerm CslTerm
term))
    LocatorMap
forall k a. Map k a
M.empty
    ((Locale -> [CslTerm]) -> [Locale] -> [CslTerm]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Locale -> [CslTerm]
localeTerms ([Locale] -> [CslTerm]) -> [Locale] -> [CslTerm]
forall a b. (a -> b) -> a -> b
$ Style -> [Locale]
styleLocale Style
sty)