{-# 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
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 _
(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
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
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
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]
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')
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
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
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
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 []
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)
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 "???"]
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)]) [] : _)])
= [Text -> [Text]
T.words Text
refids]
getNoteCitationIds (Note _) = [[]]
getNoteCitationIds _ = []
isNote :: Inline -> Bool
isNote :: Inline -> Bool
isNote (Note _) = Bool
True
isNote (Cite _ [Note _]) = Bool
True
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
(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
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
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
("","",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)
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
(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
(la :: Text
la, _) <- 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 [('{','}'), ('[',']')] 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
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
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
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 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
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
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)
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
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)
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 "." (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 :: 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 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
isLocatorPunct '–' = Bool
False
isLocatorPunct ':' = Bool
False
isLocatorPunct c :: 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 "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)