{-# 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           Data.Text                (Text)
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, Text) -> Block) -> [(Formatted, Text)] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map (Style -> (Formatted, Text) -> Block
renderPandoc' Style
style) ([(Formatted, Text)] -> [Block]) -> [(Formatted, Text)] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Formatted] -> [Text] -> [(Formatted, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip (BiblioData -> [Formatted]
bibliography BiblioData
result) (BiblioData -> [Text]
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 Text Int
notemap       = Pandoc -> Map Text Int
mkNoteMap (Meta -> [Block] -> Pandoc
Pandoc Meta
m3 [Block]
bs)
      hanging :: Bool
hanging       = (Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just "true")
                       (Style -> Maybe Bibliography
biblio Style
style Maybe Bibliography -> (Bibliography -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                        Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "hanging-indent" ([(Text, Text)] -> Maybe Text)
-> (Bibliography -> [(Text, Text)]) -> Bibliography -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bibliography -> [(Text, Text)]
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 Text Int -> Inline -> Inline
addFirstNoteNumber Map Text 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 Text Int -> Inline -> Inline
addFirstNoteNumber :: Map Text Int -> Inline -> Inline
addFirstNoteNumber notemap :: Map Text Int
notemap
  s :: Inline
s@(Span ("",["first-reference-note-number"],[("refid",refid :: Text
refid)]) _)
  = case Text -> Map Text Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
refid Map Text 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 Text Int
mkNoteMap :: Pandoc -> Map Text Int
mkNoteMap doc :: Pandoc
doc =
  ((Int, Text) -> Map Text Int -> Map Text Int)
-> Map Text Int -> [(Int, Text)] -> Map Text Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Text) -> Map Text Int -> Map Text Int
go Map Text Int
forall a. Monoid a => a
mempty ([(Int, Text)] -> Map Text Int) -> [(Int, Text)] -> Map Text Int
forall a b. (a -> b) -> a -> b
$ [(Int, [Text])] -> [(Int, Text)]
splitUp ([(Int, [Text])] -> [(Int, Text)])
-> [(Int, [Text])] -> [(Int, Text)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Text]] -> [(Int, [Text])]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] ([[Text]] -> [(Int, [Text])]) -> [[Text]] -> [(Int, [Text])]
forall a b. (a -> b) -> a -> b
$ (Inline -> [[Text]]) -> Pandoc -> [[Text]]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [[Text]]
getNoteCitationIds Pandoc
doc
  where
   splitUp :: [(Int, [Text])] -> [(Int, Text)]
   splitUp :: [(Int, [Text])] -> [(Int, Text)]
splitUp = ((Int, [Text]) -> [(Int, Text)])
-> [(Int, [Text])] -> [(Int, Text)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(n :: Int
n,ss :: [Text]
ss) -> (Text -> (Int, Text)) -> [Text] -> [(Int, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
n,) [Text]
ss)
   go :: (Int, Text) -> M.Map Text Int -> M.Map Text Int
   go :: (Int, Text) -> Map Text Int -> Map Text Int
go (notenumber :: Int
notenumber, citeid :: Text
citeid) = Text -> Int -> Map Text Int -> Map Text Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
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 Meta -> Maybe [Inline]
refTitle Meta
meta of
                      Nothing ->
                        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
refDiv]
                      Just ils :: [Inline]
ils -> [Block]
bs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
                        [Int -> Attr -> [Inline] -> Block
Header 1 ("bibliography", ["unnumbered"], []) [Inline]
ils,
                         Block
refDiv]
  where
   refclasses :: [Text]
refclasses = "references" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: if Bool
hanging then ["hanging-indent"] else []
   refDiv :: Block
refDiv = Attr -> [Block] -> Block
Div ("refs", [Text]
refclasses, []) [Block]
refs
   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"]
   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

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) = Text -> Bool
isYesValue (Text -> Text
T.toLower Text
s)
truish (MetaInlines ils :: [Inline]
ils) = Text -> Bool
isYesValue (Text -> Text
T.toLower ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils))
truish (MetaBlocks [Plain ils :: [Inline]
ils]) = Text -> Bool
isYesValue (Text -> Text
T.toLower ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils))
truish _ = Bool
False

isYesValue :: Text -> Bool
isYesValue :: Text -> 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 = Literal -> Text
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 Text
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 Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe Text
toText
  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 Text -> String -> IO Style
readCSLFile Maybe Text
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 Text -> String -> IO Style
readCSLFile Maybe Text
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 Text -> Style -> IO Style
localizeCSL Maybe Text
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" (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Locale -> Text
localeLang Locale
l)
         String -> String -> IO ()
setEnv "LANG"   (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Locale -> Text
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 Text
citids = (Inline -> Set Text) -> Pandoc -> Set Text
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Set Text
getCitationIds (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks)
  let idpred :: Text -> Bool
idpred = if "*" Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
citids
                  then Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True
                  else (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
citids)
  [Reference]
bibRefs <- (Text -> Bool) -> MetaValue -> IO [Reference]
getBibRefs Text -> 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 Text (Map Text LocatorMap) -> Abbreviations
Abbreviations Map Text (Map Text 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

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

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 :: (Text -> Bool) -> MetaValue -> IO [Reference]
getBibRefs :: (Text -> Bool) -> MetaValue -> IO [Reference]
getBibRefs idpred :: Text -> 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 ((Text -> Bool) -> MetaValue -> IO [Reference]
getBibRefs Text -> Bool
idpred) [MetaValue]
xs
getBibRefs idpred :: Text -> Bool
idpred (MetaInlines xs :: [Inline]
xs) = (Text -> Bool) -> MetaValue -> IO [Reference]
getBibRefs Text -> 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 :: Text -> 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` (Text -> Bool) -> String -> IO [Reference]
readBiblioFile Text -> 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 = Text -> Literal
Literal (Text -> Literal) -> Text -> Literal
forall a b. (a -> b) -> a -> b
$ Text -> Text
decodeEntities (Literal -> Text
unLiteral (Literal -> Text) -> Literal -> Text
forall a b. (a -> b) -> a -> b
$ Reference -> Literal
refId Reference
ref) }

decodeEntities :: Text -> Text
decodeEntities :: Text -> Text
decodeEntities t :: Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Nothing -> ""
  Just ('&',xs :: Text
xs) ->
    let (ys :: Text
ys,zs :: Text
zs) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==';') Text
xs
    in  case Text -> Maybe (Char, Text)
T.uncons Text
zs of
           Just (';',ws :: Text
ws) -> case String -> Maybe String
lookupEntity  ('&'Char -> String -> String
forall a. a -> [a] -> [a]
: Text -> String
T.unpack Text
ys String -> String -> String
forall a. [a] -> [a] -> [a]
++ ";") of
#if MIN_VERSION_tagsoup(0,13,0)
                              Just s :: String
s  -> String -> Text
T.pack String
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
decodeEntities Text
ws
#else
                              Just c  -> T.cons c (decodeEntities ws)
#endif
                              Nothing -> Char -> Text -> Text
T.cons '&' (Text -> Text
decodeEntities Text
xs)
           _      -> Char -> Text -> Text
T.cons '&' (Text -> Text
decodeEntities Text
xs)
  Just (x :: Char
x,xs :: Text
xs) -> Char -> Text -> Text
T.cons Char
x (Text -> Text
decodeEntities Text
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 -> [[Text]]
getNoteCitationIds :: Inline -> [[Text]]
getNoteCitationIds (Note [Para (Span ("",["reference-id-list"]
                                      ,[("refids",refids :: Text
refids)]) [] : _)])
  -- see deNote below which inserts this special Span
  = [Text -> [Text]
T.words 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] -> Maybe Char
headInline [Inline]
ys of
               Nothing -> 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
               Just w :: Char
w  -> Inline
q Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str (Char -> Text
T.singleton Char
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] -> Maybe Char
headInline [Inline]
ys of
            Nothing -> []
            Just s' :: Char
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
$ Char -> Text
T.singleton Char
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] -> Maybe Char
lastInline [Inline]
ils Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just '.'
  = [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) -> Maybe Char -> 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)) (Maybe Char -> Bool)
-> ([Inline] -> Maybe Char) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Maybe Char
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 Text
getCitationIds :: Inline -> Set Text
getCitationIds (Cite cs :: [Citation]
cs _) = [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 Text
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 :: Text
la, lo :: Text
lo, s :: [Inline]
s)  = LocatorMap -> [Inline] -> (Text, Text, [Inline])
locatorWords LocatorMap
locMap ([Inline] -> (Text, Text, [Inline]))
-> [Inline] -> (Text, Text, [Inline])
forall a b. (a -> b) -> a -> b
$ Citation -> [Inline]
citationSuffix Citation
c
          s' :: [Inline]
s'      = case (Text
la,Text
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 :: Text
CSL.citeId         = 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 :: Text
CSL.citeLabel      = Text
la
                     , citeLocator :: Text
CSL.citeLocator    = Text
lo
                     , citeNoteNumber :: Text
CSL.citeNoteNumber = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ 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] -> (Text, Text, [Inline])
locatorWords :: LocatorMap -> [Inline] -> (Text, Text, [Inline])
locatorWords locMap :: LocatorMap
locMap inp :: [Inline]
inp =
  case Parsec [Inline] () (Text, Text, [Inline])
-> String -> [Inline] -> Either ParseError (Text, Text, [Inline])
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (LocatorMap -> Parsec [Inline] () (Text, Text, [Inline])
forall st. LocatorMap -> Parsec [Inline] st (Text, Text, [Inline])
pLocatorWords LocatorMap
locMap) "suffix" ([Inline] -> Either ParseError (Text, Text, [Inline]))
-> [Inline] -> Either ParseError (Text, Text, [Inline])
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
splitInp [Inline]
inp of
       Right r :: (Text, Text, [Inline])
r -> (Text, Text, [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 (Text, Text, [Inline])
pLocatorWords :: LocatorMap -> Parsec [Inline] st (Text, Text, [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 :: Text
la, lo :: Text
lo) <- LocatorMap -> Parsec [Inline] st (Text, Text)
forall st. LocatorMap -> Parsec [Inline] st (Text, Text)
pLocatorDelimited LocatorMap
locMap Parsec [Inline] st (Text, Text)
-> Parsec [Inline] st (Text, Text)
-> Parsec [Inline] st (Text, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LocatorMap -> Parsec [Inline] st (Text, Text)
forall st. LocatorMap -> Parsec [Inline] st (Text, Text)
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"
  (Text, Text, [Inline]) -> Parsec [Inline] st (Text, Text, [Inline])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
la, Text -> Text
trim Text
lo, [Inline]
s)

pLocatorDelimited :: LocatorMap -> Parsec [Inline] st (Text, Text)
pLocatorDelimited :: LocatorMap -> Parsec [Inline] st (Text, Text)
pLocatorDelimited locMap :: LocatorMap
locMap = Parsec [Inline] st (Text, Text) -> Parsec [Inline] st (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (Text, Text)
 -> Parsec [Inline] st (Text, Text))
-> Parsec [Inline] st (Text, Text)
-> Parsec [Inline] st (Text, Text)
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 :: Text
la, _) <- LocatorMap -> Parsec [Inline] st (Text, Bool)
forall st. LocatorMap -> Parsec [Inline] st (Text, 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, Text)
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, Text) -> ParsecT [Inline] u Identity (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify Inline
t) }
  [(Bool, Text)]
gs <- ParsecT [Inline] st Identity (Bool, Text)
-> ParsecT [Inline] st Identity [(Bool, Text)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([(Char, Char)]
-> ParsecT [Inline] st Identity (Bool, Text)
-> ParsecT [Inline] st Identity (Bool, Text)
forall st.
[(Char, Char)]
-> Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
pBalancedBraces [('{','}'), ('[',']')] ParsecT [Inline] st Identity (Bool, Text)
forall u. ParsecT [Inline] u Identity (Bool, Text)
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 :: Text
lo = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Bool, Text) -> Text) -> [(Bool, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Text) -> Text
forall a b. (a, b) -> b
snd [(Bool, Text)]
gs
  (Text, Text) -> Parsec [Inline] st (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
la, Text
lo)

pLocatorLabelDelimited :: LocatorMap -> Parsec [Inline] st (Text, Bool)
pLocatorLabelDelimited :: LocatorMap -> Parsec [Inline] st (Text, Bool)
pLocatorLabelDelimited locMap :: LocatorMap
locMap
  = LocatorMap
-> Parsec [Inline] st Text -> Parsec [Inline] st (Text, Bool)
forall st.
LocatorMap
-> Parsec [Inline] st Text -> Parsec [Inline] st (Text, Bool)
pLocatorLabel' LocatorMap
locMap Parsec [Inline] st Text
forall u. ParsecT [Inline] u Identity Text
lim Parsec [Inline] st (Text, Bool)
-> Parsec [Inline] st (Text, Bool)
-> Parsec [Inline] st (Text, Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text, Bool) -> Parsec [Inline] st (Text, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ("page", Bool
True)
    where
        lim :: ParsecT [Inline] u Identity Text
lim = Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline -> Text)
-> ParsecT [Inline] u Identity Inline
-> ParsecT [Inline] u Identity Text
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 (Text, Text)
pLocatorIntegrated :: LocatorMap -> Parsec [Inline] st (Text, Text)
pLocatorIntegrated locMap :: LocatorMap
locMap = Parsec [Inline] st (Text, Text) -> Parsec [Inline] st (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (Text, Text)
 -> Parsec [Inline] st (Text, Text))
-> Parsec [Inline] st (Text, Text)
-> Parsec [Inline] st (Text, Text)
forall a b. (a -> b) -> a -> b
$ do
  (la :: Text
la, wasImplicit :: Bool
wasImplicit) <- LocatorMap -> Parsec [Inline] st (Text, Bool)
forall st. LocatorMap -> Parsec [Inline] st (Text, 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, Text) -> Parsec [Inline] st Text
modifier = if Bool
wasImplicit
                    then (Bool, Text) -> Parsec [Inline] st Text
forall st. (Bool, Text) -> Parsec [Inline] st Text
requireDigits
                    else (Bool, Text) -> Parsec [Inline] st Text
forall st. (Bool, Text) -> Parsec [Inline] st Text
requireRomansOrDigits
  Text
g <- ParsecT [Inline] st Identity Text
-> ParsecT [Inline] st Identity Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] st Identity Text
 -> ParsecT [Inline] st Identity Text)
-> ParsecT [Inline] st Identity Text
-> ParsecT [Inline] st Identity Text
forall a b. (a -> b) -> a -> b
$ Bool -> Parsec [Inline] st (Bool, Text)
forall st. Bool -> Parsec [Inline] st (Bool, Text)
pLocatorWordIntegrated (Bool -> Bool
not Bool
wasImplicit) Parsec [Inline] st (Bool, Text)
-> ((Bool, Text) -> ParsecT [Inline] st Identity Text)
-> ParsecT [Inline] st Identity Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, Text) -> ParsecT [Inline] st Identity Text
forall st. (Bool, Text) -> Parsec [Inline] st Text
modifier
  [Text]
gs <- ParsecT [Inline] st Identity Text
-> ParsecT [Inline] st Identity [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Inline] st Identity Text
-> ParsecT [Inline] st Identity Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] st Identity Text
 -> ParsecT [Inline] st Identity Text)
-> ParsecT [Inline] st Identity Text
-> ParsecT [Inline] st Identity Text
forall a b. (a -> b) -> a -> b
$ Bool -> Parsec [Inline] st (Bool, Text)
forall st. Bool -> Parsec [Inline] st (Bool, Text)
pLocatorWordIntegrated Bool
False Parsec [Inline] st (Bool, Text)
-> ((Bool, Text) -> ParsecT [Inline] st Identity Text)
-> ParsecT [Inline] st Identity Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, Text) -> ParsecT [Inline] st Identity Text
forall st. (Bool, Text) -> Parsec [Inline] st Text
modifier)
  let lo :: Text
lo = [Text] -> Text
T.concat (Text
gText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
gs)
  (Text, Text) -> Parsec [Inline] st (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
la, Text
lo)

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

pLocatorLabel' :: LocatorMap -> Parsec [Inline] st Text -> Parsec [Inline] st (Text, Bool)
pLocatorLabel' :: LocatorMap
-> Parsec [Inline] st Text -> Parsec [Inline] st (Text, Bool)
pLocatorLabel' locMap :: LocatorMap
locMap lim :: Parsec [Inline] st Text
lim = Text -> Parsec [Inline] st (Text, Bool)
go ""
    where
      -- grow the match string until we hit the end
      -- trying to find the largest match for a label
      go :: Text -> Parsec [Inline] st (Text, Bool)
go acc :: Text
acc = Parsec [Inline] st (Text, Bool) -> Parsec [Inline] st (Text, Bool)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (Text, Bool)
 -> Parsec [Inline] st (Text, Bool))
-> Parsec [Inline] st (Text, Bool)
-> Parsec [Inline] st (Text, 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 Text -> 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 Text -> Parsec [Inline] st Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st Text -> Parsec [Inline] st Text)
-> Parsec [Inline] st Text -> Parsec [Inline] st Text
forall a b. (a -> b) -> a -> b
$ Parsec [Inline] st Text -> Parsec [Inline] st Text
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead Parsec [Inline] st Text
lim)
          let s :: Text
s = Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline
tInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ts)
          case Text -> LocatorMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Text
trim Text
s) LocatorMap
locMap of
            -- try to find a longer one, or return this one
            Just l :: Text
l -> Text -> Parsec [Inline] st (Text, Bool)
go Text
s Parsec [Inline] st (Text, Bool)
-> Parsec [Inline] st (Text, Bool)
-> Parsec [Inline] st (Text, Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text, Bool) -> Parsec [Inline] st (Text, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
l, Bool
False)
            Nothing -> Text -> Parsec [Inline] st (Text, Bool)
go Text
s

-- hard requirement for a locator to have some real digits in it
requireDigits :: (Bool, Text) -> Parsec [Inline] st Text
requireDigits :: (Bool, Text) -> Parsec [Inline] st Text
requireDigits (_, s :: Text
s) = if Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDigit Text
s)
                          then String -> Parsec [Inline] st Text
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail "requireDigits"
                          else Text -> Parsec [Inline] st Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
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, Text) -> Parsec [Inline] st Text
requireRomansOrDigits :: (Bool, Text) -> Parsec [Inline] st Text
requireRomansOrDigits (d :: Bool
d, s :: Text
s) = if Bool -> Bool
not Bool
d
                                  then String -> Parsec [Inline] st Text
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail "requireRomansOrDigits"
                                  else Text -> Parsec [Inline] st Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s

pLocatorWordIntegrated :: Bool -> Parsec [Inline] st (Bool, Text)
pLocatorWordIntegrated :: Bool -> Parsec [Inline] st (Bool, Text)
pLocatorWordIntegrated isFirst :: Bool
isFirst = Parsec [Inline] st (Bool, Text) -> Parsec [Inline] st (Bool, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (Bool, Text)
 -> Parsec [Inline] st (Bool, Text))
-> Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
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 ""
  Text
sp <- Text
-> ParsecT [Inline] st Identity Text
-> ParsecT [Inline] st Identity Text
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 Text
-> ParsecT [Inline] st Identity Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ParsecT [Inline] st Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return " ")
  (dig :: Bool
dig, s :: Text
s) <- [(Char, Char)]
-> Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
forall st.
[(Char, Char)]
-> Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
pBalancedBraces [('(',')'), ('[',']'), ('{','}')] Parsec [Inline] st (Bool, Text)
forall u. ParsecT [Inline] u Identity (Bool, Text)
pPageSeq
  (Bool, Text) -> Parsec [Inline] st (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
dig, Text
punct Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
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, Text)
                -> Parsec [Inline] st (Bool, Text)
pBalancedBraces :: [(Char, Char)]
-> Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
pBalancedBraces braces :: [(Char, Char)]
braces p :: Parsec [Inline] st (Bool, Text)
p = Parsec [Inline] st (Bool, Text) -> Parsec [Inline] st (Bool, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (Bool, Text)
 -> Parsec [Inline] st (Bool, Text))
-> Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
  [(Bool, Text)]
ss <- Parsec [Inline] st (Bool, Text)
-> ParsecT [Inline] st Identity [(Bool, Text)]
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, Text)
surround
  (Bool, Text) -> Parsec [Inline] st (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Text) -> Parsec [Inline] st (Bool, Text))
-> (Bool, Text) -> Parsec [Inline] st (Bool, Text)
forall a b. (a -> b) -> a -> b
$ [(Bool, Text)] -> (Bool, Text)
anyWereDigitLike [(Bool, Text)]
ss
  where
      except :: Parsec [Inline] st (Bool, Text)
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, Text)
-> Parsec [Inline] st (Bool, Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parsec [Inline] st (Bool, Text)
p
      -- outer and inner
      surround :: Parsec [Inline] st (Bool, Text)
surround = (Parsec [Inline] st (Bool, Text)
 -> (Char, Char) -> Parsec [Inline] st (Bool, Text))
-> Parsec [Inline] st (Bool, Text)
-> [(Char, Char)]
-> Parsec [Inline] st (Bool, Text)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a :: Parsec [Inline] st (Bool, Text)
a (open :: Char
open, close :: Char
close) -> Char
-> Char
-> Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
forall u.
Char
-> Char
-> ParsecT [Inline] u Identity (Bool, Text)
-> ParsecT [Inline] u Identity (Bool, Text)
sur Char
open Char
close Parsec [Inline] st (Bool, Text)
except Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec [Inline] st (Bool, Text)
a)
                       Parsec [Inline] st (Bool, Text)
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, Text)
-> ParsecT [Inline] u Identity (Bool, Text)
sur c :: Char
c c' :: Char
c' m :: ParsecT [Inline] u Identity (Bool, Text)
m = ParsecT [Inline] u Identity (Bool, Text)
-> ParsecT [Inline] u Identity (Bool, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] u Identity (Bool, Text)
 -> ParsecT [Inline] u Identity (Bool, Text))
-> ParsecT [Inline] u Identity (Bool, Text)
-> ParsecT [Inline] u Identity (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
          (d :: Bool
d, mid :: Text
mid) <- ParsecT [Inline] u Identity Text
-> ParsecT [Inline] u Identity Text
-> ParsecT [Inline] u Identity (Bool, Text)
-> ParsecT [Inline] u Identity (Bool, Text)
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, Text)
-> ParsecT [Inline] u Identity (Bool, Text)
-> ParsecT [Inline] u Identity (Bool, Text)
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, Text)
m)
          (Bool, Text) -> ParsecT [Inline] u Identity (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
d, Char -> Text -> Text
T.cons Char
c (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text) -> Char -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Char -> Text
T.snoc Char
c' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$  Text
mid)

      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, Text)
pPageSeq :: Parsec [Inline] st (Bool, Text)
pPageSeq = Parsec [Inline] st (Bool, Text)
forall u. ParsecT [Inline] u Identity (Bool, Text)
oneDotTwo Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec [Inline] st (Bool, Text)
forall u. ParsecT [Inline] u Identity (Bool, Text)
withPeriod
  where
      oneDotTwo :: ParsecT [Inline] st Identity (Bool, Text)
oneDotTwo = do
          (Bool, Text)
u <- ParsecT [Inline] st Identity (Bool, Text)
forall u. ParsecT [Inline] u Identity (Bool, Text)
pPageUnit
          [(Bool, Text)]
us <- ParsecT [Inline] st Identity (Bool, Text)
-> ParsecT [Inline] st Identity [(Bool, Text)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Inline] st Identity (Bool, Text)
forall u. ParsecT [Inline] u Identity (Bool, Text)
withPeriod
          (Bool, Text) -> ParsecT [Inline] st Identity (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Text) -> ParsecT [Inline] st Identity (Bool, Text))
-> (Bool, Text) -> ParsecT [Inline] st Identity (Bool, Text)
forall a b. (a -> b) -> a -> b
$ [(Bool, Text)] -> (Bool, Text)
anyWereDigitLike ((Bool, Text)
u(Bool, Text) -> [(Bool, Text)] -> [(Bool, Text)]
forall a. a -> [a] -> [a]
:[(Bool, Text)]
us)
      withPeriod :: ParsecT [Inline] u Identity (Bool, Text)
withPeriod = ParsecT [Inline] u Identity (Bool, Text)
-> ParsecT [Inline] u Identity (Bool, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] u Identity (Bool, Text)
 -> ParsecT [Inline] u Identity (Bool, Text))
-> ParsecT [Inline] u Identity (Bool, Text)
-> ParsecT [Inline] u Identity (Bool, Text)
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, Text)
u <- ParsecT [Inline] u Identity (Bool, Text)
-> ParsecT [Inline] u Identity (Bool, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT [Inline] u Identity (Bool, Text)
forall u. ParsecT [Inline] u Identity (Bool, Text)
pPageUnit
          (Bool, Text) -> ParsecT [Inline] u Identity (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Text) -> Bool
forall a b. (a, b) -> a
fst (Bool, Text)
u, Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify Inline
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Bool, Text) -> Text
forall a b. (a, b) -> b
snd (Bool, Text)
u)

anyWereDigitLike :: [(Bool, Text)] -> (Bool, Text)
anyWereDigitLike :: [(Bool, Text)] -> (Bool, Text)
anyWereDigitLike as :: [(Bool, Text)]
as = (((Bool, Text) -> Bool) -> [(Bool, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool, Text) -> Bool
forall a b. (a, b) -> a
fst [(Bool, Text)]
as, [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Bool, Text) -> Text) -> [(Bool, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Text) -> Text
forall a b. (a, b) -> b
snd [(Bool, Text)]
as)

pPageUnit :: Parsec [Inline] st (Bool, Text)
pPageUnit :: Parsec [Inline] st (Bool, Text)
pPageUnit = Parsec [Inline] st (Bool, Text)
forall u. ParsecT [Inline] u Identity (Bool, Text)
roman Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
-> Parsec [Inline] st (Bool, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec [Inline] st (Bool, Text)
forall u. ParsecT [Inline] u Identity (Bool, Text)
plainUnit
  where
      -- roman is a 'digit'
      roman :: ParsecT [Inline] st Identity (Bool, Text)
roman = (Bool
True,) (Text -> (Bool, Text))
-> ParsecT [Inline] st Identity Text
-> ParsecT [Inline] st Identity (Bool, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Inline] st Identity Text
forall u. ParsecT [Inline] u Identity Text
pRoman
      plainUnit :: ParsecT [Inline] u Identity (Bool, Text)
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 :: Text
s = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ts
          -- otherwise look for actual digits or -s
          (Bool, Text) -> ParsecT [Inline] u Identity (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDigit Text
s, Text
s)

pRoman :: Parsec [Inline] st Text
pRoman :: Parsec [Inline] st Text
pRoman = Parsec [Inline] st Text -> Parsec [Inline] st Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st Text -> Parsec [Inline] st Text)
-> Parsec [Inline] st Text -> Parsec [Inline] st Text
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 Text
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                      Just _  -> Text -> Parsec [Inline] st Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parsec [Inline] st Text)
-> Text -> Parsec [Inline] st Text
forall a b. (a -> b) -> a -> b
$ Text
xs
       _      -> Parsec [Inline] st Text
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 Text Text

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 -> Text -> Text -> LocatorMap -> LocatorMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (CslTerm -> Text
termSingular CslTerm
term) (CslTerm -> Text
cslTerm CslTerm
term)
                (LocatorMap -> LocatorMap)
-> (LocatorMap -> LocatorMap) -> LocatorMap -> LocatorMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> LocatorMap -> LocatorMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (CslTerm -> Text
termPlural CslTerm
term) (CslTerm -> Text
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)