{-# 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, (<|>))
processCites :: Style -> [Reference] -> Pandoc -> Pandoc
processCites :: Style -> [Reference] -> Pandoc -> Pandoc
processCites Style
style [Reference]
refs (Pandoc Meta
m1 [Block]
b1) =
let metanocites :: Maybe MetaValue
metanocites = Text -> Meta -> Maybe MetaValue
lookupMeta Text
"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 Meta
m2 [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 Text
"nocite" Meta
m1) [Block]
b1) Int
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' String
"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 Text
"notes-after-punctuation" Meta
m1
Pandoc Meta
m3 [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
Maybe MetaValue
Nothing -> Meta
m3
Just MetaValue
x -> Text -> MetaValue -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"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 Text
"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 Text
"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 Map Text Int
notemap
s :: Inline
s@(Span (Text
"",[Text
"first-reference-note-number"],[(Text
"refid",Text
refid)]) [Inline]
_)
= 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
Maybe Int
Nothing -> Inline
s
Just 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 Map Text Int
_
(Note [Para (Span (Text
"",[Text
"reference-id-list"],[(Text, Text)]
_) [] : [Inline]
ils)])
= [Block] -> Inline
Note [[Inline] -> Block
Para [Inline]
ils]
addFirstNoteNumber Map Text Int
_ Inline
x = Inline
x
mkNoteMap :: Pandoc -> M.Map Text Int
mkNoteMap :: Pandoc -> Map Text Int
mkNoteMap 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 [Int
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 (\(Int
n,[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 (Int
notenumber, 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
insertRefs :: Bool -> Meta -> [Block] -> [Block] -> [Block]
insertRefs :: Bool -> Meta -> [Block] -> [Block] -> [Block]
insertRefs Bool
_ Meta
_ [] [Block]
bs = [Block]
bs
insertRefs Bool
hanging Meta
meta [Block]
refs [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
([Block]
bs', Bool
True) -> [Block]
bs'
([Block]
_, Bool
False)
-> case Meta -> Maybe [Inline]
refTitle Meta
meta of
Maybe [Inline]
Nothing ->
case [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
bs of
Header Int
lev (Text
id',[Text]
classes,[(Text, Text)]
kvs) [Inline]
ys : [Block]
xs ->
[Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
xs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
[Int -> (Text, [Text], [(Text, Text)]) -> [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,
(Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
"refs",[Text]
refclasses,[]) [Block]
refs]
[Block]
_ -> [Block]
bs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
refDiv]
Just [Inline]
ils -> [Block]
bs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
[Int -> (Text, [Text], [(Text, Text)]) -> [Inline] -> Block
Header Int
1 (Text
"bibliography", [Text
"unnumbered"], []) [Inline]
ils,
Block
refDiv]
where
refclasses :: [Text]
refclasses = Text
"references" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: if Bool
hanging then [Text
"hanging-indent"] else []
refDiv :: Block
refDiv = (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
"refs", [Text]
refclasses, []) [Block]
refs
addUnNumbered :: [a] -> [a]
addUnNumbered [a]
cs = a
"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
/= a
"unnumbered"]
go :: Block -> State Bool Block
go :: Block -> StateT Bool Identity Block
go (Div (Text
"refs",[Text]
cs,[(Text, Text)]
kvs) [Block]
xs) = do
Bool -> StateT Bool Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Bool
True
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
$ (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
"refs",[Text]
cs',[(Text, Text)]
kvs) ([Block]
xs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
refs)
go 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 =
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"reference-section-title" Meta
meta of
Just (MetaString Text
s) -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Text -> Inline
Str Text
s]
Just (MetaInlines [Inline]
ils) -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
Just (MetaBlocks [Plain [Inline]
ils]) -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
Just (MetaBlocks [Para [Inline]
ils]) -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
Maybe MetaValue
_ -> Maybe [Inline]
forall a. Maybe a
Nothing
isRefRemove :: Meta -> Bool
isRefRemove :: Meta -> Bool
isRefRemove 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 Text
"suppress-bibliography" Meta
meta
isLinkCitations :: Meta -> Bool
isLinkCitations :: Meta -> Bool
isLinkCitations 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 Text
"link-citations" Meta
meta
truish :: MetaValue -> Bool
truish :: MetaValue -> Bool
truish (MetaBool Bool
t) = Bool
t
truish (MetaString Text
s) = Text -> Bool
isYesValue (Text -> Text
T.toLower Text
s)
truish (MetaInlines [Inline]
ils) = Text -> Bool
isYesValue (Text -> Text
T.toLower ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils))
truish (MetaBlocks [Plain [Inline]
ils]) = Text -> Bool
isYesValue (Text -> Text
T.toLower ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils))
truish MetaValue
_ = Bool
False
isYesValue :: Text -> Bool
isYesValue :: Text -> Bool
isYesValue Text
"t" = Bool
True
isYesValue Text
"true" = Bool
True
isYesValue Text
"yes" = Bool
True
isYesValue Text
"on" = Bool
True
isYesValue Text
_ = Bool
False
mkNociteWildcards :: [Reference] -> [[Citation]] -> [[Citation]]
mkNociteWildcards :: [Reference] -> [[Citation]] -> [[Citation]]
mkNociteWildcards [Reference]
refs = ([Citation] -> [Citation]) -> [[Citation]] -> [[Citation]]
forall a b. (a -> b) -> [a] -> [b]
map [Citation] -> [Citation]
expandStar
where expandStar :: [Citation] -> [Citation]
expandStar [Citation]
cs =
case [Citation
c | Citation
c <- [Citation]
cs
, Citation -> Text
citationId Citation
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*"] of
[] -> [Citation]
cs
[Citation]
_ -> [Citation]
allcites
allcites :: [Citation]
allcites = (Reference -> Citation) -> [Reference] -> [Citation]
forall a b. (a -> b) -> [a] -> [b]
map (\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 = Int
0,
citationHash :: Int
citationHash = Int
0 }) [Reference]
refs
removeNocaseSpans :: Inline -> [Inline]
removeNocaseSpans :: Inline -> [Inline]
removeNocaseSpans (Span (Text
"",[Text
"nocase"],[]) [Inline]
xs) = [Inline]
xs
removeNocaseSpans Inline
x = [Inline
x]
processCites' :: Pandoc -> IO Pandoc
processCites' :: Pandoc -> IO Pandoc
processCites' (Pandoc Meta
meta [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 String
"csl") ((IOError -> IO (Maybe String)) -> IO (Maybe String))
-> (IOError -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \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 String
"pandoc") ((IOError -> IO (Maybe String)) -> IO (Maybe String))
-> (IOError -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \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 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 Text
"references" Meta
meta
let cslfile :: Maybe String
cslfile = (Text -> Meta -> Maybe MetaValue
lookupMeta Text
"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 Text
"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 Text
"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 Text
"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 Maybe String
Nothing String
_ = IO Style
forall (m :: * -> *) a. MonadPlus m => m a
mzero
tryReadCSLFile (Just String
d) 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 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
_ -> Maybe String -> String -> IO Style
tryReadCSLFile Maybe String
mbpandocdir String
"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 String
"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')
case Style -> [Locale]
styleLocale Style
csl of
(Locale
l:[Locale]
_) -> do
String -> String -> IO ()
setEnv String
"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 String
"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 String
"LANG"
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
envlang
then do
String -> String -> IO ()
setEnv String
"LANG" String
"en_US.UTF-8"
String -> String -> IO ()
setEnv String
"LC_ALL" String
"en_US.UTF-8"
else
String -> String -> IO ()
setEnv String
"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
"*" 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 Text
"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 Text
"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 (\Word8
s -> Word8
s Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
32 Bool -> Bool -> Bool
|| (Word8
s Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
9 Bool -> Bool -> Bool
&& Word8
s Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
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))
(\String
f -> [String] -> String -> IO (Maybe String)
findFile ([String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String
"."] (\String
g -> [String
".", 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' String
"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 Text
s) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
toText (MetaList [MetaValue]
xs) = case [MetaValue] -> [MetaValue]
forall a. [a] -> [a]
reverse [MetaValue]
xs of
[] -> Maybe Text
forall a. Maybe a
Nothing
(MetaValue
x:[MetaValue]
_) -> MetaValue -> Maybe Text
toText MetaValue
x
toText (MetaInlines [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 MetaValue
_ = Maybe Text
forall a. Maybe a
Nothing
toPath :: MetaValue -> Maybe String
toPath :: MetaValue -> Maybe String
toPath (MetaString 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
toPath (MetaList [MetaValue]
xs) = case [MetaValue] -> [MetaValue]
forall a. [a] -> [a]
reverse [MetaValue]
xs of
[] -> Maybe String
forall a. Maybe a
Nothing
(MetaValue
x:[MetaValue]
_) -> MetaValue -> Maybe String
toPath MetaValue
x
toPath (MetaInlines [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 MetaValue
_ = Maybe String
forall a. Maybe a
Nothing
getBibRefs :: (Text -> Bool) -> MetaValue -> IO [Reference]
getBibRefs :: (Text -> Bool) -> MetaValue -> IO [Reference]
getBibRefs Text -> Bool
idpred (MetaList [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 Text -> Bool
idpred (MetaInlines [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 Text -> Bool
idpred (MetaString Text
s) = do
String
path <- [String] -> String -> IO (Maybe String)
findFile [String
"."] (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 Text -> Bool
_ MetaValue
_ = [Reference] -> IO [Reference]
forall (m :: * -> *) a. Monad m => a -> m a
return []
unescapeRefId :: Reference -> Reference
unescapeRefId :: Reference -> Reference
unescapeRefId 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 Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
Maybe (Char, Text)
Nothing -> Text
""
Just (Char
'&',Text
xs) ->
let (Text
ys,Text
zs) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
';') Text
xs
in case Text -> Maybe (Char, Text)
T.uncons Text
zs of
Just (Char
';',Text
ws) -> case String -> Maybe String
lookupEntity (Char
'&'Char -> String -> String
forall a. a -> [a] -> [a]
: Text -> String
T.unpack Text
ys String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";") of
#if MIN_VERSION_tagsoup(0,13,0)
Just 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
Maybe String
Nothing -> Char -> Text -> Text
T.cons Char
'&' (Text -> Text
decodeEntities Text
xs)
Maybe (Char, Text)
_ -> Char -> Text -> Text
T.cons Char
'&' (Text -> Text
decodeEntities Text
xs)
Just (Char
x,Text
xs) -> Char -> Text -> Text
T.cons Char
x (Text -> Text
decodeEntities Text
xs)
processCite :: Style -> M.Map [Citation] Formatted -> Inline -> Inline
processCite :: Style -> Map [Citation] Formatted -> Inline -> Inline
processCite Style
s Map [Citation] Formatted
cs (Cite [Citation]
t [Inline]
_) =
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 [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))
Maybe Formatted
_ -> [Inline] -> Inline
Strong [Text -> Inline
Str Text
"???"]
where isSuppressAuthor :: Citation -> Bool
isSuppressAuthor Citation
c = Citation -> CitationMode
citationMode Citation
c CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
SuppressAuthor
processCite Style
_ Map [Citation] Formatted
_ Inline
x = Inline
x
getNoteCitationIds :: Inline -> [[Text]]
getNoteCitationIds :: Inline -> [[Text]]
getNoteCitationIds (Note [Para (Span (Text
"",[Text
"reference-id-list"]
,[(Text
"refids",Text
refids)]) [] : [Inline]
_)])
= [Text -> [Text]
T.words Text
refids]
getNoteCitationIds (Note [Block]
_) = [[]]
getNoteCitationIds Inline
_ = []
isNote :: Inline -> Bool
isNote :: Inline -> Bool
isNote (Note [Block]
_) = Bool
True
isNote (Cite [Citation]
_ [Note [Block]
_]) = Bool
True
isNote (Cite [Citation]
_ [Superscript [Inline]
_]) = Bool
True
isNote Inline
_ = Bool
False
mvPunctInsideQuote :: Inline -> Inline -> [Inline]
mvPunctInsideQuote :: Inline -> Inline -> [Inline]
mvPunctInsideQuote (Quoted QuoteType
qt [Inline]
ils) (Str Text
s) | Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
".", Text
","] =
[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 Inline
il Inline
il' = [Inline
il, Inline
il']
isSpacy :: Inline -> Bool
isSpacy :: Inline -> Bool
isSpacy Inline
Space = Bool
True
isSpacy Inline
SoftBreak = Bool
True
isSpacy Inline
_ = Bool
False
mvPunct :: Bool -> Style -> [Inline] -> [Inline]
mvPunct :: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty (Inline
x : Inline
Space : [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 Bool
moveNotes Style
sty (Inline
q : Inline
s : Inline
x : [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
Maybe Char
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 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 Bool
moveNotes Style
sty (Cite [Citation]
cs [Inline]
ils : [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
> Int
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
Maybe Char
Nothing -> []
Just 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 Bool
moveNotes Style
sty (q :: Inline
q@(Quoted QuoteType
_ [Inline]
_) : w :: Inline
w@(Str Text
_) : Inline
x : [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 Bool
moveNotes Style
sty (Inline
s : Inline
x : [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 Bool
moveNotes Style
sty (Inline
s : x :: Inline
x@(Cite [Citation]
_ (Superscript [Inline]
_ : [Inline]
_)) : [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 Bool
moveNotes Style
sty (Cite [Citation]
cs [Inline]
ils : Str Text
"." : [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 Char
'.'
= [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 Bool
moveNotes Style
sty (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
xs
mvPunct Bool
_ Style
_ [] = []
endWithPunct :: Bool -> [Inline] -> Bool
endWithPunct :: Bool -> [Inline] -> Bool
endWithPunct Bool
_ [] = Bool
True
endWithPunct Bool
onlyFinal xs :: [Inline]
xs@(Inline
_:[Inline]
_) =
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
(Char
d:Char
c:String
_) | Char -> Bool
isPunctuation Char
d
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
onlyFinal
Bool -> Bool -> Bool
&& Char -> Bool
isEndPunct Char
c -> Bool
True
(Char
c:String
_) | Char -> Bool
isEndPunct Char
c -> Bool
True
| Bool
otherwise -> Bool
False
where isEndPunct :: Char -> Bool
isEndPunct Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
".,;:!?" :: 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
".,;:!?" :: 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 (Citation
c:[Citation]
cs) [Note [Para [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 [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 Inline
x = Inline
x
specialSpan :: [Citation] -> Inline
specialSpan [Citation]
cs =
(Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text
"",[Text
"reference-id-list"],
[(Text
"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 Text
"(" : Cite [Citation]
cs [Note [Para [Inline]
xs]] : Str Text
")" : [Inline]
ys) =
Text -> Inline
Str Text
"(" 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 Text
")" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ys
go' (Inline
x : Cite [Citation]
cs [Note [Para [Inline]
xs]] : [Inline]
ys) | Bool -> Bool
not (Inline -> Bool
isSpacy Inline
x) =
Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
"," 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]
zs -> [[Citation] -> [Inline] -> Inline
Cite [Citation]
cs [Inline]
zs]) [Inline]
xs [Inline]
ys
go' (Str Text
"(" : Note [Para [Inline]
xs] : Str Text
")" : [Inline]
ys) =
Text -> Inline
Str Text
"(" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ (Text -> Inline
Str Text
")" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ys)
go' (Inline
x : Note [Para [Inline]
xs] : [Inline]
ys) | Bool -> Bool
not (Inline -> Bool
isSpacy Inline
x) =
Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
"," 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 [Citation]
cs [Note [Para [Inline]
xs]] : [Inline]
ys) = ([Inline] -> [Inline]) -> [Inline] -> [Inline] -> [Inline]
comb (\[Inline]
zs -> [[Citation] -> [Inline] -> Inline
Cite [Citation]
cs [Inline]
zs]) [Inline]
xs [Inline]
ys
go' (Note [Para [Inline]
xs] : [Inline]
ys) = ([Inline] -> [Inline]) -> [Inline] -> [Inline] -> [Inline]
comb [Inline] -> [Inline]
forall a. a -> a
id [Inline]
xs [Inline]
ys
go' [Inline]
xs = [Inline]
xs
comb :: ([Inline] -> [Inline]) -> [Inline] -> [Inline] -> [Inline]
comb :: ([Inline] -> [Inline]) -> [Inline] -> [Inline] -> [Inline]
comb [Inline] -> [Inline]
f [Inline]
xs [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 -> [Char
c]) : Inline
s : [Inline]
zs)
| Inline -> Bool
isSpacy Inline
s Bool -> Bool -> Bool
&& (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') = [Inline]
zs
removeLeadingPunct [Inline]
zs = [Inline]
zs
in [Inline] -> [Inline]
f [Inline]
xs' [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
ys
getCitation :: Inline -> [[Citation]]
getCitation :: Inline -> [[Citation]]
getCitation Inline
i | Cite [Citation]
t [Inline]
_ <- Inline
i = [[Citation]
t]
| Bool
otherwise = []
getCitationIds :: Inline -> Set.Set Text
getCitationIds :: Inline -> Set Text
getCitationIds (Cite [Citation]
cs [Inline]
_) = [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 Inline
_ = Set Text
forall a. Monoid a => a
mempty
setHashes :: Inline -> State Int Inline
setHashes :: Inline -> StateT Int Identity Inline
setHashes Inline
i | Cite [Citation]
t [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 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
+ Int
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 LocatorMap
locMap Citation
c
= let (Text
la, Text
lo, [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
(Text
"",Text
"",Inline
x:[Inline]
_)
| Bool -> Bool
not (Inline -> Bool
isPunct Inline
x) -> Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
s
(Text, Text, [Inline])
_ -> [Inline]
s
isPunct :: Inline -> Bool
isPunct (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
x,Text
_))) = Char -> Bool
isPunctuation Char
x
isPunct Inline
_ = 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 (\Char
c -> Char -> Bool
splitOn Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c)
where
splitOn :: Char -> Bool
splitOn Char
':' = Bool
False
splitOn Char
c = Char -> Bool
isPunctuation Char
c
locatorWords :: LocatorMap -> [Inline] -> (Text, Text, [Inline])
locatorWords :: LocatorMap -> [Inline] -> (Text, Text, [Inline])
locatorWords LocatorMap
locMap [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) String
"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 (Text, Text, [Inline])
r -> (Text, Text, [Inline])
r
Left ParseError
_ -> (Text
"",Text
"",[Inline]
inp)
pLocatorWords :: LocatorMap -> Parsec [Inline] st (Text, Text, [Inline])
pLocatorWords :: LocatorMap -> Parsec [Inline] st (Text, Text, [Inline])
pLocatorWords 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 String
"," (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',')
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
(Text
la, 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
(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 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 String
"{" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{')
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
(Text
la, Bool
_) <- LocatorMap -> Parsec [Inline] st (Text, Bool)
forall st. LocatorMap -> Parsec [Inline] st (Text, Bool)
pLocatorLabelDelimited LocatorMap
locMap
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 [(Char
'{',Char
'}'), (Char
'[',Char
']')] 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 String
"}" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}')
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 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 (Text
"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 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
(Text
la, Bool
wasImplicit) <- LocatorMap -> Parsec [Inline] st (Text, Bool)
forall st. LocatorMap -> Parsec [Inline] st (Text, Bool)
pLocatorLabelIntegrated LocatorMap
locMap
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 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 (Text
"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' LocatorMap
locMap Parsec [Inline] st Text
lim = Text -> Parsec [Inline] st (Text, Bool)
go Text
""
where
go :: Text -> Parsec [Inline] st (Text, Bool)
go 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
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
Just 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)
Maybe Text
Nothing -> Text -> Parsec [Inline] st (Text, Bool)
go Text
s
requireDigits :: (Bool, Text) -> Parsec [Inline] st Text
requireDigits :: (Bool, Text) -> Parsec [Inline] st Text
requireDigits (Bool
_, 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 String
"requireDigits"
else Text -> Parsec [Inline] st Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
requireRomansOrDigits :: (Bool, Text) -> Parsec [Inline] st Text
requireRomansOrDigits :: (Bool, Text) -> Parsec [Inline] st Text
requireRomansOrDigits (Bool
d, Text
s) = if Bool -> Bool
not Bool
d
then String -> Parsec [Inline] st Text
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"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 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 Text
""
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
""
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 Text
"" (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 Text
" ")
(Bool
dig, 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 [(Char
'(',Char
')'), (Char
'[',Char
']'), (Char
'{',Char
'}')] 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)
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 [(Char, Char)]
braces 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
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 (\Parsec [Inline] st (Bool, Text)
a (Char
open, 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 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 Char
c Char
c' 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
(Bool
d, 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, Text
"") 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 (\(Char
o, 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 String
"braces" (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
flattened)
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
Inline
p <- String -> (Char -> Bool) -> Parsec [Inline] u Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar String
"." (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
(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 [(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 :: 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
(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 Text
xs -> case String -> Maybe Int
parseRomanNumeral (Text -> String
T.unpack Text
xs) of
Maybe Int
Nothing -> Parsec [Inline] st Text
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just Int
_ -> 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
Inline
_ -> Parsec [Inline] st Text
forall (m :: * -> *) a. MonadPlus m => m a
mzero
isLocatorPunct :: Char -> Bool
isLocatorPunct :: Char -> Bool
isLocatorPunct Char
'-' = Bool
False
isLocatorPunct Char
'–' = Bool
False
isLocatorPunct Char
':' = Bool
False
isLocatorPunct Char
c = Char -> Bool
isPunctuation Char
c
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 String
"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 String
"locator separator" Char -> Bool
isLocatorSep
isLocatorSep :: Char -> Bool
isLocatorSep :: Char -> Bool
isLocatorSep Char
',' = Bool
True
isLocatorSep Char
';' = Bool
True
isLocatorSep Char
_ = Bool
False
pMatchChar :: String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar :: String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar String
msg 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 -> [Char
c])) = Char -> Bool
f Char
c
mc Inline
_ = 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 String
"' '" (\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 Text
"\160")
pMatch :: String -> (Inline -> Bool) -> Parsec [Inline] st Inline
pMatch :: String -> (Inline -> Bool) -> Parsec [Inline] st Inline
pMatch String
msg 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 Style
sty =
(CslTerm -> LocatorMap -> LocatorMap)
-> LocatorMap -> [CslTerm] -> LocatorMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\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)