{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.CSL.Pandoc (processCites, processCites')
where
import Prelude
import Control.Applicative ((<|>))
import qualified Control.Exception as E
import Control.Monad
import Control.Monad.State
import Data.Aeson
import qualified Data.ByteString.Lazy as L
import Data.Char (isDigit, isPunctuation, isSpace)
import qualified Data.Map as M
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Maybe (fromMaybe)
import System.Directory (getAppUserDataDirectory)
import System.Environment (getEnv)
import System.FilePath
import System.IO.Error (isDoesNotExistError)
import System.SetEnv (setEnv)
import Text.CSL.Data (getDefaultCSL)
import Text.CSL.Exception
import Text.CSL.Input.Bibutils (convertRefs, readBiblioFile)
import Text.CSL.Output.Pandoc (renderPandoc, renderPandoc',
headInline, initInline, tailInline, toCapital)
import Text.CSL.Parser
import Text.CSL.Proc
import Text.CSL.Reference hiding (Value, processCites)
import Text.CSL.Style hiding (Citation (..), Cite (..))
import qualified Text.CSL.Style as CSL
import Text.CSL.Util (findFile, lastInline,
parseRomanNumeral, splitStrWhen, tr',
trim)
import Text.HTML.TagSoup.Entity (lookupEntity)
import Text.Pandoc
import Text.Pandoc.Builder (deleteMeta, setMeta)
import Text.Pandoc.Shared (stringify, ordNub)
import Text.Pandoc.Walk
import Text.Parsec hiding (State, (<|>))
processCites :: Style -> [Reference] -> Pandoc -> Pandoc
processCites :: Style -> [Reference] -> Pandoc -> Pandoc
processCites style :: Style
style refs :: [Reference]
refs (Pandoc m1 :: Meta
m1 b1 :: [Block]
b1) =
let metanocites :: Maybe MetaValue
metanocites = Text -> Meta -> Maybe MetaValue
lookupMeta "nocite" Meta
m1
nocites :: Maybe [[Citation]]
nocites = [Reference] -> [[Citation]] -> [[Citation]]
mkNociteWildcards [Reference]
refs ([[Citation]] -> [[Citation]])
-> (MetaValue -> [[Citation]]) -> MetaValue -> [[Citation]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> [[Citation]]) -> MetaValue -> [[Citation]]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [[Citation]]
getCitation (MetaValue -> [[Citation]])
-> Maybe MetaValue -> Maybe [[Citation]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MetaValue
metanocites
Pandoc m2 :: Meta
m2 b2 :: [Block]
b2 = State Int Pandoc -> Int -> Pandoc
forall s a. State s a -> s -> a
evalState ((Inline -> StateT Int Identity Inline)
-> Pandoc -> State Int Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Inline -> StateT Int Identity Inline
setHashes (Pandoc -> State Int Pandoc) -> Pandoc -> State Int Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc (Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
deleteMeta "nocite" Meta
m1) [Block]
b1) 1
grps :: [[Citation]]
grps = (Inline -> [[Citation]]) -> Pandoc -> [[Citation]]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [[Citation]]
getCitation (Meta -> [Block] -> Pandoc
Pandoc Meta
m2 [Block]
b2) [[Citation]] -> [[Citation]] -> [[Citation]]
forall a. [a] -> [a] -> [a]
++ [[Citation]] -> Maybe [[Citation]] -> [[Citation]]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [[Citation]]
nocites
locMap :: LocatorMap
locMap = Style -> LocatorMap
locatorMap Style
style
result :: BiblioData
result = ProcOpts -> Style -> [Reference] -> Citations -> BiblioData
citeproc ProcOpts
procOpts{ linkCitations :: Bool
linkCitations = Meta -> Bool
isLinkCitations Meta
m2}
Style
style [Reference]
refs (Style -> Citations -> Citations
setNearNote Style
style (Citations -> Citations) -> Citations -> Citations
forall a b. (a -> b) -> a -> b
$
([Citation] -> [Cite]) -> [[Citation]] -> Citations
forall a b. (a -> b) -> [a] -> [b]
map ((Citation -> Cite) -> [Citation] -> [Cite]
forall a b. (a -> b) -> [a] -> [b]
map (LocatorMap -> Citation -> Cite
toCslCite LocatorMap
locMap)) [[Citation]]
grps)
cits_map :: Map [Citation] Formatted
cits_map = String -> Map [Citation] Formatted -> Map [Citation] Formatted
forall a. String -> a -> a
tr' "cits_map" (Map [Citation] Formatted -> Map [Citation] Formatted)
-> Map [Citation] Formatted -> Map [Citation] Formatted
forall a b. (a -> b) -> a -> b
$ [([Citation], Formatted)] -> Map [Citation] Formatted
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([Citation], Formatted)] -> Map [Citation] Formatted)
-> [([Citation], Formatted)] -> Map [Citation] Formatted
forall a b. (a -> b) -> a -> b
$ [[Citation]] -> [Formatted] -> [([Citation], Formatted)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Citation]]
grps (BiblioData -> [Formatted]
citations BiblioData
result)
biblioList :: [Block]
biblioList = ((Formatted, String) -> Block) -> [(Formatted, String)] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map (Style -> (Formatted, String) -> Block
renderPandoc' Style
style) ([(Formatted, String)] -> [Block])
-> [(Formatted, String)] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Formatted] -> [String] -> [(Formatted, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (BiblioData -> [Formatted]
bibliography BiblioData
result) (BiblioData -> [String]
citationIds BiblioData
result)
moveNotes :: Bool
moveNotes = Bool -> (MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True MetaValue -> Bool
truish (Maybe MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall a b. (a -> b) -> a -> b
$
Text -> Meta -> Maybe MetaValue
lookupMeta "notes-after-punctuation" Meta
m1
Pandoc m3 :: Meta
m3 bs :: [Block]
bs = ([Inline] -> [Inline]) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
style) (Pandoc -> Pandoc) -> (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pandoc -> Pandoc
deNote (Pandoc -> Pandoc) -> (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Inline -> Inline) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Style -> Map [Citation] Formatted -> Inline -> Inline
processCite Style
style Map [Citation] Formatted
cits_map) (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
m2 [Block]
b2
m :: Meta
m = case Maybe MetaValue
metanocites of
Nothing -> Meta
m3
Just x :: MetaValue
x -> Text -> MetaValue -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta "nocite" MetaValue
x Meta
m3
notemap :: Map String Int
notemap = Pandoc -> Map String Int
mkNoteMap (Meta -> [Block] -> Pandoc
Pandoc Meta
m3 [Block]
bs)
hanging :: Bool
hanging = Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "true")
(Style -> Maybe Bibliography
biblio Style
style Maybe Bibliography
-> (Bibliography -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "hanging-indent" ([(String, String)] -> Maybe String)
-> (Bibliography -> [(String, String)])
-> Bibliography
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bibliography -> [(String, String)]
bibOptions)
in Meta -> [Block] -> Pandoc
Pandoc Meta
m ([Block] -> Pandoc) -> [Block] -> Pandoc
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Map String Int -> Inline -> Inline
addFirstNoteNumber Map String Int
notemap)
([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ ([Inline] -> [Inline]) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk ((Inline -> [Inline]) -> [Inline] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
removeNocaseSpans)
([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Bool -> Meta -> [Block] -> [Block] -> [Block]
insertRefs Bool
hanging Meta
m [Block]
biblioList [Block]
bs
addFirstNoteNumber :: M.Map String Int -> Inline -> Inline
addFirstNoteNumber :: Map String Int -> Inline -> Inline
addFirstNoteNumber notemap :: Map String Int
notemap
s :: Inline
s@(Span ("",["first-reference-note-number"],[("refid",refid :: Text
refid)]) _)
= case String -> Map String Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> String
T.unpack Text
refid) Map String Int
notemap of
Nothing -> Inline
s
Just n :: Int
n -> Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
addFirstNoteNumber _
(Note [Para (Span ("",["reference-id-list"],_) [] : ils :: [Inline]
ils)])
= [Block] -> Inline
Note [[Inline] -> Block
Para [Inline]
ils]
addFirstNoteNumber _ x :: Inline
x = Inline
x
mkNoteMap :: Pandoc -> M.Map String Int
mkNoteMap :: Pandoc -> Map String Int
mkNoteMap doc :: Pandoc
doc =
((Int, String) -> Map String Int -> Map String Int)
-> Map String Int -> [(Int, String)] -> Map String Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, String) -> Map String Int -> Map String Int
go Map String Int
forall a. Monoid a => a
mempty ([(Int, String)] -> Map String Int)
-> [(Int, String)] -> Map String Int
forall a b. (a -> b) -> a -> b
$ [(Int, [String])] -> [(Int, String)]
splitUp ([(Int, [String])] -> [(Int, String)])
-> [(Int, [String])] -> [(Int, String)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[String]] -> [(Int, [String])]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] ([[String]] -> [(Int, [String])])
-> [[String]] -> [(Int, [String])]
forall a b. (a -> b) -> a -> b
$ (Inline -> [[String]]) -> Pandoc -> [[String]]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [[String]]
getNoteCitationIds Pandoc
doc
where
splitUp :: [(Int, [String])] -> [(Int, String)]
splitUp :: [(Int, [String])] -> [(Int, String)]
splitUp = ((Int, [String]) -> [(Int, String)])
-> [(Int, [String])] -> [(Int, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(n :: Int
n,ss :: [String]
ss) -> (String -> (Int, String)) -> [String] -> [(Int, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
n,) [String]
ss)
go :: (Int, String) -> M.Map String Int -> M.Map String Int
go :: (Int, String) -> Map String Int -> Map String Int
go (notenumber :: Int
notenumber, citeid :: String
citeid) = String -> Int -> Map String Int -> Map String Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
citeid Int
notenumber
insertRefs :: Bool -> Meta -> [Block] -> [Block] -> [Block]
insertRefs :: Bool -> Meta -> [Block] -> [Block] -> [Block]
insertRefs _ _ [] bs :: [Block]
bs = [Block]
bs
insertRefs hanging :: Bool
hanging meta :: Meta
meta refs :: [Block]
refs bs :: [Block]
bs =
if Meta -> Bool
isRefRemove Meta
meta
then [Block]
bs
else case State Bool [Block] -> Bool -> ([Block], Bool)
forall s a. State s a -> s -> (a, s)
runState ((Block -> StateT Bool Identity Block)
-> [Block] -> State Bool [Block]
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Block -> StateT Bool Identity Block
go [Block]
bs) Bool
False of
(bs' :: [Block]
bs', True) -> [Block]
bs'
(_, False) ->
case [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
bs of
Header lev :: Int
lev (id' :: Text
id',classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) ys :: [Inline]
ys : xs :: [Block]
xs ->
[Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
xs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
[Int -> Attr -> [Inline] -> Block
Header Int
lev (Text
id',[Text] -> [Text]
forall a. (IsString a, Eq a) => [a] -> [a]
addUnNumbered [Text]
classes,[(Text, Text)]
kvs) [Inline]
ys,
Attr -> [Block] -> Block
Div ("refs",[Text]
refclasses,[]) [Block]
refs]
_ -> [Block]
bs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
refHeader [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
[Attr -> [Block] -> Block
Div ("refs",[Text]
refclasses,[]) [Block]
refs]
where
refclasses :: [Text]
refclasses = "references" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: if Bool
hanging then ["hanging-indent"] else []
go :: Block -> State Bool Block
go :: Block -> StateT Bool Identity Block
go (Div ("refs",cs :: [Text]
cs,kvs :: [(Text, Text)]
kvs) xs :: [Block]
xs) = do
Bool -> StateT Bool Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Bool
True
let cs' :: [Text]
cs' = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
cs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
refclasses
Block -> StateT Bool Identity Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> StateT Bool Identity Block)
-> Block -> StateT Bool Identity Block
forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
Div ("refs",[Text]
cs',[(Text, Text)]
kvs) ([Block]
xs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
refs)
go x :: Block
x = Block -> StateT Bool Identity Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
x
addUnNumbered :: [a] -> [a]
addUnNumbered cs :: [a]
cs = "unnumbered" a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a
c | a
c <- [a]
cs, a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= "unnumbered"]
refHeader :: [Block]
refHeader = case Meta -> Maybe [Inline]
refTitle Meta
meta of
Just ils :: [Inline]
ils ->
[Int -> Attr -> [Inline] -> Block
Header 1 ("bibliography", ["unnumbered"], []) [Inline]
ils]
_ -> []
refTitle :: Meta -> Maybe [Inline]
refTitle :: Meta -> Maybe [Inline]
refTitle meta :: Meta
meta =
case Text -> Meta -> Maybe MetaValue
lookupMeta "reference-section-title" Meta
meta of
Just (MetaString s :: Text
s) -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Text -> Inline
Str Text
s]
Just (MetaInlines ils :: [Inline]
ils) -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
Just (MetaBlocks [Plain ils :: [Inline]
ils]) -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
Just (MetaBlocks [Para ils :: [Inline]
ils]) -> [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
_ -> Maybe [Inline]
forall a. Maybe a
Nothing
isRefRemove :: Meta -> Bool
isRefRemove :: Meta -> Bool
isRefRemove meta :: Meta
meta =
Bool -> (MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False MetaValue -> Bool
truish (Maybe MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta "suppress-bibliography" Meta
meta
isLinkCitations :: Meta -> Bool
isLinkCitations :: Meta -> Bool
isLinkCitations meta :: Meta
meta =
Bool -> (MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False MetaValue -> Bool
truish (Maybe MetaValue -> Bool) -> Maybe MetaValue -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta "link-citations" Meta
meta
truish :: MetaValue -> Bool
truish :: MetaValue -> Bool
truish (MetaBool t :: Bool
t) = Bool
t
truish (MetaString s :: Text
s) = String -> Bool
isYesValue (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
s)
truish (MetaInlines ils :: [Inline]
ils) = String -> Bool
isYesValue (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils))
truish (MetaBlocks [Plain ils :: [Inline]
ils]) = String -> Bool
isYesValue (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils))
truish _ = Bool
False
isYesValue :: String -> Bool
isYesValue :: String -> Bool
isYesValue "t" = Bool
True
isYesValue "true" = Bool
True
isYesValue "yes" = Bool
True
isYesValue "on" = Bool
True
isYesValue _ = Bool
False
mkNociteWildcards :: [Reference] -> [[Citation]] -> [[Citation]]
mkNociteWildcards :: [Reference] -> [[Citation]] -> [[Citation]]
mkNociteWildcards refs :: [Reference]
refs = ([Citation] -> [Citation]) -> [[Citation]] -> [[Citation]]
forall a b. (a -> b) -> [a] -> [b]
map [Citation] -> [Citation]
expandStar
where expandStar :: [Citation] -> [Citation]
expandStar cs :: [Citation]
cs =
case [Citation
c | Citation
c <- [Citation]
cs
, Citation -> Text
citationId Citation
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "*"] of
[] -> [Citation]
cs
_ -> [Citation]
allcites
allcites :: [Citation]
allcites = (Reference -> Citation) -> [Reference] -> [Citation]
forall a b. (a -> b) -> [a] -> [b]
map (\ref :: Reference
ref -> Citation :: Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
Citation{
citationId :: Text
citationId = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Literal -> String
unLiteral (Reference -> Literal
refId Reference
ref),
citationPrefix :: [Inline]
citationPrefix = [],
citationSuffix :: [Inline]
citationSuffix = [],
citationMode :: CitationMode
citationMode = CitationMode
NormalCitation,
citationNoteNum :: Int
citationNoteNum = 0,
citationHash :: Int
citationHash = 0 }) [Reference]
refs
removeNocaseSpans :: Inline -> [Inline]
removeNocaseSpans :: Inline -> [Inline]
removeNocaseSpans (Span ("",["nocase"],[]) xs :: [Inline]
xs) = [Inline]
xs
removeNocaseSpans x :: Inline
x = [Inline
x]
processCites' :: Pandoc -> IO Pandoc
processCites' :: Pandoc -> IO Pandoc
processCites' (Pandoc meta :: Meta
meta blocks :: [Block]
blocks) = do
Maybe String
mbcsldir <- IO (Maybe String)
-> (IOError -> IO (Maybe String)) -> IO (Maybe String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getAppUserDataDirectory "csl") ((IOError -> IO (Maybe String)) -> IO (Maybe String))
-> (IOError -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \e :: IOError
e ->
if IOError -> Bool
isDoesNotExistError IOError
e
then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
else IOError -> IO (Maybe String)
forall e a. Exception e => e -> IO a
E.throwIO IOError
e
Maybe String
mbpandocdir <- IO (Maybe String)
-> (IOError -> IO (Maybe String)) -> IO (Maybe String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getAppUserDataDirectory "pandoc") ((IOError -> IO (Maybe String)) -> IO (Maybe String))
-> (IOError -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \e :: IOError
e ->
if IOError -> Bool
isDoesNotExistError IOError
e
then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
else IOError -> IO (Maybe String)
forall e a. Exception e => e -> IO a
E.throwIO IOError
e
let inlineRefError :: String -> a
inlineRefError s :: String
s = CiteprocException -> a
forall a e. Exception e => e -> a
E.throw (CiteprocException -> a) -> CiteprocException -> a
forall a b. (a -> b) -> a -> b
$ String -> CiteprocException
ErrorParsingReferences String
s
let inlineRefs :: [Reference]
inlineRefs = (String -> [Reference])
-> ([Reference] -> [Reference])
-> Either String [Reference]
-> [Reference]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> [Reference]
forall a. String -> a
inlineRefError [Reference] -> [Reference]
forall a. a -> a
id
(Either String [Reference] -> [Reference])
-> Either String [Reference] -> [Reference]
forall a b. (a -> b) -> a -> b
$ Maybe MetaValue -> Either String [Reference]
convertRefs (Maybe MetaValue -> Either String [Reference])
-> Maybe MetaValue -> Either String [Reference]
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta "references" Meta
meta
let cslfile :: Maybe String
cslfile = (Text -> Meta -> Maybe MetaValue
lookupMeta "csl" Meta
meta Maybe MetaValue -> Maybe MetaValue -> Maybe MetaValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Meta -> Maybe MetaValue
lookupMeta "citation-style" Meta
meta)
Maybe MetaValue -> (MetaValue -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe String
toPath
let mbLocale :: Maybe String
mbLocale = (Text -> Meta -> Maybe MetaValue
lookupMeta "lang" Meta
meta Maybe MetaValue -> Maybe MetaValue -> Maybe MetaValue
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> Meta -> Maybe MetaValue
lookupMeta "locale" Meta
meta)
Maybe MetaValue -> (MetaValue -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe String
toPath
let tryReadCSLFile :: Maybe String -> String -> IO Style
tryReadCSLFile Nothing _ = IO Style
forall (m :: * -> *) a. MonadPlus m => m a
mzero
tryReadCSLFile (Just d :: String
d) f :: String
f = IO Style -> (SomeException -> IO Style) -> IO Style
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Maybe String -> String -> IO Style
readCSLFile Maybe String
mbLocale (String
d String -> String -> String
</> String
f))
(\(SomeException
_ :: E.SomeException) -> IO Style
forall (m :: * -> *) a. MonadPlus m => m a
mzero)
Style
csl <- case Maybe String
cslfile of
Just f :: String
f | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
f) -> Maybe String -> String -> IO Style
readCSLFile Maybe String
mbLocale String
f
_ -> Maybe String -> String -> IO Style
tryReadCSLFile Maybe String
mbpandocdir "default.csl"
IO Style -> IO Style -> IO Style
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String -> String -> IO Style
tryReadCSLFile Maybe String
mbcsldir "chicago-author-date.csl"
IO Style -> IO Style -> IO Style
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (IO ByteString
getDefaultCSL IO ByteString -> (ByteString -> IO Style) -> IO Style
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Maybe String -> Style -> IO Style
localizeCSL Maybe String
mbLocale (Style -> IO Style)
-> (ByteString -> Style) -> ByteString -> IO Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Style
parseCSL')
case Style -> [Locale]
styleLocale Style
csl of
(l :: Locale
l:_) -> do
String -> String -> IO ()
setEnv "LC_ALL" (Locale -> String
localeLang Locale
l)
String -> String -> IO ()
setEnv "LANG" (Locale -> String
localeLang Locale
l)
[] -> do
String
envlang <- String -> IO String
getEnv "LANG"
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
envlang
then do
String -> String -> IO ()
setEnv "LANG" "en_US.UTF-8"
String -> String -> IO ()
setEnv "LC_ALL" "en_US.UTF-8"
else
String -> String -> IO ()
setEnv "LC_ALL" String
envlang
let citids :: Set String
citids = (Inline -> Set String) -> Pandoc -> Set String
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Set String
getCitationIds (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks)
let idpred :: String -> Bool
idpred = if "*" String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
citids
then Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True
else (String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
citids)
[Reference]
bibRefs <- (String -> Bool) -> MetaValue -> IO [Reference]
getBibRefs String -> Bool
idpred (MetaValue -> IO [Reference]) -> MetaValue -> IO [Reference]
forall a b. (a -> b) -> a -> b
$ MetaValue -> Maybe MetaValue -> MetaValue
forall a. a -> Maybe a -> a
fromMaybe ([MetaValue] -> MetaValue
MetaList [])
(Maybe MetaValue -> MetaValue) -> Maybe MetaValue -> MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta "bibliography" Meta
meta
let refs :: [Reference]
refs = [Reference]
inlineRefs [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++ [Reference]
bibRefs
let cslAbbrevFile :: Maybe String
cslAbbrevFile = Text -> Meta -> Maybe MetaValue
lookupMeta "citation-abbreviations" Meta
meta Maybe MetaValue -> (MetaValue -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe String
toPath
let skipLeadingSpace :: ByteString -> ByteString
skipLeadingSpace = (Word8 -> Bool) -> ByteString -> ByteString
L.dropWhile (\s :: Word8
s -> Word8
s Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 32 Bool -> Bool -> Bool
|| (Word8
s Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 9 Bool -> Bool -> Bool
&& Word8
s Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 13))
Abbreviations
abbrevs <- IO Abbreviations
-> (String -> IO Abbreviations) -> Maybe String -> IO Abbreviations
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Abbreviations -> IO Abbreviations
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String (Map String LocatorMap) -> Abbreviations
Abbreviations Map String (Map String LocatorMap)
forall k a. Map k a
M.empty))
(\f :: String
f -> [String] -> String -> IO (Maybe String)
findFile ([String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ["."] (\g :: String
g -> [".", String
g]) Maybe String
mbcsldir) String
f IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CiteprocException -> IO String
forall e a. Exception e => e -> IO a
E.throwIO (CiteprocException -> IO String) -> CiteprocException -> IO String
forall a b. (a -> b) -> a -> b
$ String -> CiteprocException
CouldNotFindAbbrevFile String
f) String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return IO String -> (String -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
String -> IO ByteString
L.readFile IO ByteString
-> (ByteString -> IO Abbreviations) -> IO Abbreviations
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(String -> IO Abbreviations)
-> (Abbreviations -> IO Abbreviations)
-> Either String Abbreviations
-> IO Abbreviations
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Abbreviations
forall a. HasCallStack => String -> a
error Abbreviations -> IO Abbreviations
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Abbreviations -> IO Abbreviations)
-> (ByteString -> Either String Abbreviations)
-> ByteString
-> IO Abbreviations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Abbreviations
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String Abbreviations)
-> (ByteString -> ByteString)
-> ByteString
-> Either String Abbreviations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
skipLeadingSpace)
Maybe String
cslAbbrevFile
let csl' :: Style
csl' = Style
csl{ styleAbbrevs :: Abbreviations
styleAbbrevs = Abbreviations
abbrevs }
Pandoc -> IO Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> IO Pandoc) -> Pandoc -> IO Pandoc
forall a b. (a -> b) -> a -> b
$ Style -> [Reference] -> Pandoc -> Pandoc
processCites (String -> Style -> Style
forall a. String -> a -> a
tr' "CSL" Style
csl') [Reference]
refs (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks
toPath :: MetaValue -> Maybe String
toPath :: MetaValue -> Maybe String
toPath (MetaString s :: Text
s) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
toPath (MetaList xs :: [MetaValue]
xs) = case [MetaValue] -> [MetaValue]
forall a. [a] -> [a]
reverse [MetaValue]
xs of
[] -> Maybe String
forall a. Maybe a
Nothing
(x :: MetaValue
x:_) -> MetaValue -> Maybe String
toPath MetaValue
x
toPath (MetaInlines ils :: [Inline]
ils) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils
toPath _ = Maybe String
forall a. Maybe a
Nothing
getBibRefs :: (String -> Bool) -> MetaValue -> IO [Reference]
getBibRefs :: (String -> Bool) -> MetaValue -> IO [Reference]
getBibRefs idpred :: String -> Bool
idpred (MetaList xs :: [MetaValue]
xs) = [[Reference]] -> [Reference]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Reference]] -> [Reference])
-> IO [[Reference]] -> IO [Reference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (MetaValue -> IO [Reference]) -> [MetaValue] -> IO [[Reference]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> Bool) -> MetaValue -> IO [Reference]
getBibRefs String -> Bool
idpred) [MetaValue]
xs
getBibRefs idpred :: String -> Bool
idpred (MetaInlines xs :: [Inline]
xs) = (String -> Bool) -> MetaValue -> IO [Reference]
getBibRefs String -> Bool
idpred (Text -> MetaValue
MetaString (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs)
getBibRefs idpred :: String -> Bool
idpred (MetaString s :: Text
s) = do
String
path <- [String] -> String -> IO (Maybe String)
findFile ["."] (Text -> String
T.unpack Text
s) IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CiteprocException -> IO String
forall e a. Exception e => e -> IO a
E.throwIO (CiteprocException -> IO String) -> CiteprocException -> IO String
forall a b. (a -> b) -> a -> b
$ String -> CiteprocException
CouldNotFindBibFile (String -> CiteprocException) -> String -> CiteprocException
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s) String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return
(Reference -> Reference) -> [Reference] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map Reference -> Reference
unescapeRefId ([Reference] -> [Reference]) -> IO [Reference] -> IO [Reference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (String -> Bool) -> String -> IO [Reference]
readBiblioFile String -> Bool
idpred String
path
getBibRefs _ _ = [Reference] -> IO [Reference]
forall (m :: * -> *) a. Monad m => a -> m a
return []
unescapeRefId :: Reference -> Reference
unescapeRefId :: Reference -> Reference
unescapeRefId ref :: Reference
ref = Reference
ref{ refId :: Literal
refId = String -> Literal
Literal (String -> Literal) -> String -> Literal
forall a b. (a -> b) -> a -> b
$ String -> String
decodeEntities (Literal -> String
unLiteral (Literal -> String) -> Literal -> String
forall a b. (a -> b) -> a -> b
$ Reference -> Literal
refId Reference
ref) }
decodeEntities :: String -> String
decodeEntities :: String -> String
decodeEntities [] = []
decodeEntities ('&':xs :: String
xs) =
let (ys :: String
ys,zs :: String
zs) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==';') String
xs
in case String
zs of
';':ws :: String
ws -> case String -> Maybe String
lookupEntity ('&'Char -> String -> String
forall a. a -> [a] -> [a]
:String
ys String -> String -> String
forall a. [a] -> [a] -> [a]
++ ";") of
#if MIN_VERSION_tagsoup(0,13,0)
Just s :: String
s -> String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
decodeEntities String
ws
#else
Just c -> c : decodeEntities ws
#endif
Nothing -> '&' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decodeEntities String
xs
_ -> '&' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decodeEntities String
xs
decodeEntities (x :: Char
x:xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decodeEntities String
xs
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 -> [[String]]
getNoteCitationIds :: Inline -> [[String]]
getNoteCitationIds (Note [Para (Span ("",["reference-id-list"]
,[("refids",refids :: Text
refids)]) [] : _)])
= [String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
refids]
getNoteCitationIds (Note _) = [[]]
getNoteCitationIds _ = []
isNote :: Inline -> Bool
isNote :: Inline -> Bool
isNote (Note _) = Bool
True
isNote (Cite _ [Note _]) = Bool
True
isNote (Cite _ [Superscript _]) = Bool
True
isNote _ = Bool
False
mvPunctInsideQuote :: Inline -> Inline -> [Inline]
mvPunctInsideQuote :: Inline -> Inline -> [Inline]
mvPunctInsideQuote (Quoted qt :: QuoteType
qt ils :: [Inline]
ils) (Str s :: Text
s) | Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [".", ","] =
[QuoteType -> [Inline] -> Inline
Quoted QuoteType
qt ([Inline] -> [Inline]
forall a. [a] -> [a]
init [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ Inline -> Inline -> [Inline]
mvPunctInsideQuote ([Inline] -> Inline
forall a. [a] -> a
last [Inline]
ils) (Text -> Inline
Str Text
s))]
mvPunctInsideQuote il :: Inline
il il' :: Inline
il' = [Inline
il, Inline
il']
isSpacy :: Inline -> Bool
isSpacy :: Inline -> Bool
isSpacy Space = Bool
True
isSpacy SoftBreak = Bool
True
isSpacy _ = Bool
False
mvPunct :: Bool -> Style -> [Inline] -> [Inline]
mvPunct :: Bool -> Style -> [Inline] -> [Inline]
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (x :: Inline
x : Space : xs :: [Inline]
xs)
| Inline -> Bool
isSpacy Inline
x = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
xs
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (q :: Inline
q : s :: Inline
s : x :: Inline
x : ys :: [Inline]
ys)
| Inline -> Bool
isSpacy Inline
s
, Inline -> Bool
isNote Inline
x
, [Inline] -> Bool
startWithPunct [Inline]
ys
= if Bool
moveNotes
then Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$
case [Inline] -> String
headInline [Inline]
ys of
"" -> Inline
q Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
tailInline [Inline]
ys
w :: String
w -> Inline
q Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str (String -> Text
T.pack String
w) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
tailInline [Inline]
ys
else Inline
q Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
ys
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (Cite cs :: [Citation]
cs ils :: [Inline]
ils : ys :: [Inline]
ys)
| [Inline] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Inline]
ils Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1
, Inline -> Bool
isNote ([Inline] -> Inline
forall a. [a] -> a
last [Inline]
ils)
, [Inline] -> Bool
startWithPunct [Inline]
ys
, Bool
moveNotes
= [Citation] -> [Inline] -> Inline
Cite [Citation]
cs
([Inline] -> [Inline]
forall a. [a] -> [a]
init [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++
(case [Inline] -> String
headInline [Inline]
ys of
"" -> []
s' :: String
s' | Bool -> Bool
not (Bool -> [Inline] -> Bool
endWithPunct Bool
False ([Inline] -> [Inline]
forall a. [a] -> [a]
init [Inline]
ils)) -> [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s']
| Bool
otherwise -> [])
[Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Inline
forall a. [a] -> a
last [Inline]
ils]) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty ([Inline] -> [Inline]
tailInline [Inline]
ys)
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (q :: Inline
q@(Quoted _ _) : w :: Inline
w@(Str _) : x :: Inline
x : ys :: [Inline]
ys)
| Inline -> Bool
isNote Inline
x
, Style -> Bool
isPunctuationInQuote Style
sty
, Bool
moveNotes
= Inline -> Inline -> [Inline]
mvPunctInsideQuote Inline
q Inline
w [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ (Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
ys)
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (s :: Inline
s : x :: Inline
x : ys :: [Inline]
ys) | Inline -> Bool
isSpacy Inline
s, Inline -> Bool
isNote Inline
x =
Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
ys
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (s :: Inline
s : x :: Inline
x@(Cite _ (Superscript _ : _)) : ys :: [Inline]
ys)
| Inline -> Bool
isSpacy Inline
s = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
ys
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (Cite cs :: [Citation]
cs ils :: [Inline]
ils : Str "." : ys :: [Inline]
ys)
| [Inline] -> String
lastInline [Inline]
ils String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "."
= [Citation] -> [Inline] -> Inline
Cite [Citation]
cs [Inline]
ils Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
ys
mvPunct moveNotes :: Bool
moveNotes sty :: Style
sty (x :: Inline
x:xs :: [Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Bool -> Style -> [Inline] -> [Inline]
mvPunct Bool
moveNotes Style
sty [Inline]
xs
mvPunct _ _ [] = []
endWithPunct :: Bool -> [Inline] -> Bool
endWithPunct :: Bool -> [Inline] -> Bool
endWithPunct _ [] = Bool
True
endWithPunct onlyFinal :: Bool
onlyFinal xs :: [Inline]
xs@(_:_) =
case String -> String
forall a. [a] -> [a]
reverse (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs) of
[] -> Bool
True
(d :: Char
d:c :: Char
c:_) | Char -> Bool
isPunctuation Char
d
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
onlyFinal
Bool -> Bool -> Bool
&& Char -> Bool
isEndPunct Char
c -> Bool
True
(c :: Char
c:_) | Char -> Bool
isEndPunct Char
c -> Bool
True
| Bool
otherwise -> Bool
False
where isEndPunct :: Char -> Bool
isEndPunct c :: Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (".,;:!?" :: String)
startWithPunct :: [Inline] -> Bool
startWithPunct :: [Inline] -> Bool
startWithPunct = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (".,;:!?" :: String)) (String -> Bool) -> ([Inline] -> String) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> String
headInline
deNote :: Pandoc -> Pandoc
deNote :: Pandoc -> Pandoc
deNote = (Inline -> Inline) -> Pandoc -> Pandoc
forall a b. (Data a, Data b) => (a -> a) -> b -> b
topDown Inline -> Inline
go
where go :: Inline -> Inline
go (Cite (c :: Citation
c:cs :: [Citation]
cs) [Note [Para xs :: [Inline]
xs]]) =
[Citation] -> [Inline] -> Inline
Cite (Citation
cCitation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
cs) [[Block] -> Inline
Note [[Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ [Citation] -> Inline
specialSpan (Citation
cCitation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
cs) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
toCapital [Inline]
xs]]
go (Note xs :: [Block]
xs) = [Block] -> Inline
Note ([Block] -> Inline) -> [Block] -> Inline
forall a b. (a -> b) -> a -> b
$ ([Inline] -> [Inline]) -> [Block] -> [Block]
forall a b. (Data a, Data b) => (a -> a) -> b -> b
topDown [Inline] -> [Inline]
go' [Block]
xs
go x :: Inline
x = Inline
x
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 String
getCitationIds :: Inline -> Set String
getCitationIds (Cite cs :: [Citation]
cs _) = (Text -> String) -> Set Text -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> String
T.unpack (Set Text -> Set String) -> Set Text -> Set String
forall a b. (a -> b) -> a -> b
$ [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ((Citation -> Text) -> [Citation] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Citation -> Text
citationId [Citation]
cs)
getCitationIds _ = Set String
forall a. Monoid a => a
mempty
setHashes :: Inline -> State Int Inline
setHashes :: Inline -> StateT Int Identity Inline
setHashes i :: Inline
i | Cite t :: [Citation]
t ils :: [Inline]
ils <- Inline
i = do [Citation]
t' <- (Citation -> StateT Int Identity Citation)
-> [Citation] -> StateT Int Identity [Citation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Citation -> StateT Int Identity Citation
setHash [Citation]
t
Inline -> StateT Int Identity Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> StateT Int Identity Inline)
-> Inline -> StateT Int Identity Inline
forall a b. (a -> b) -> a -> b
$ [Citation] -> [Inline] -> Inline
Cite [Citation]
t' [Inline]
ils
| Bool
otherwise = Inline -> StateT Int Identity Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
i
setHash :: Citation -> State Int Citation
setHash :: Citation -> StateT Int Identity Citation
setHash c :: Citation
c = do
Int
ident <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
Int -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> StateT Int Identity ()) -> Int -> StateT Int Identity ()
forall a b. (a -> b) -> a -> b
$ Int
ident Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
Citation -> StateT Int Identity Citation
forall (m :: * -> *) a. Monad m => a -> m a
return Citation
c{ citationHash :: Int
citationHash = Int
ident }
toCslCite :: LocatorMap -> Citation -> CSL.Cite
toCslCite :: LocatorMap -> Citation -> Cite
toCslCite locMap :: LocatorMap
locMap c :: Citation
c
= let (la :: String
la, lo :: String
lo, s :: [Inline]
s) = LocatorMap -> [Inline] -> (String, String, [Inline])
locatorWords LocatorMap
locMap ([Inline] -> (String, String, [Inline]))
-> [Inline] -> (String, String, [Inline])
forall a b. (a -> b) -> a -> b
$ Citation -> [Inline]
citationSuffix Citation
c
s' :: [Inline]
s' = case (String
la,String
lo,[Inline]
s) of
("","",x :: Inline
x:_)
| Bool -> Bool
not (Inline -> Bool
isPunct Inline
x) -> Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
s
_ -> [Inline]
s
isPunct :: Inline -> Bool
isPunct (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (x :: Char
x,_))) = Char -> Bool
isPunctuation Char
x
isPunct _ = Bool
False
in Cite
emptyCite { citeId :: String
CSL.citeId = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Citation -> Text
citationId Citation
c
, citePrefix :: Formatted
CSL.citePrefix = [Inline] -> Formatted
Formatted ([Inline] -> Formatted) -> [Inline] -> Formatted
forall a b. (a -> b) -> a -> b
$ Citation -> [Inline]
citationPrefix Citation
c
, citeSuffix :: Formatted
CSL.citeSuffix = [Inline] -> Formatted
Formatted [Inline]
s'
, citeLabel :: String
CSL.citeLabel = String
la
, citeLocator :: String
CSL.citeLocator = String
lo
, citeNoteNumber :: String
CSL.citeNoteNumber = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Citation -> Int
citationNoteNum Citation
c
, authorInText :: Bool
CSL.authorInText = Citation -> CitationMode
citationMode Citation
c CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
AuthorInText
, suppressAuthor :: Bool
CSL.suppressAuthor = Citation -> CitationMode
citationMode Citation
c CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
SuppressAuthor
, citeHash :: Int
CSL.citeHash = Citation -> Int
citationHash Citation
c
}
splitInp :: [Inline] -> [Inline]
splitInp :: [Inline] -> [Inline]
splitInp = (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen (\c :: Char
c -> Char -> Bool
splitOn Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c)
where
splitOn :: Char -> Bool
splitOn ':' = Bool
False
splitOn c :: Char
c = Char -> Bool
isPunctuation Char
c
locatorWords :: LocatorMap -> [Inline] -> (String, String, [Inline])
locatorWords :: LocatorMap -> [Inline] -> (String, String, [Inline])
locatorWords locMap :: LocatorMap
locMap inp :: [Inline]
inp =
case Parsec [Inline] () (String, String, [Inline])
-> String
-> [Inline]
-> Either ParseError (String, String, [Inline])
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (LocatorMap -> Parsec [Inline] () (String, String, [Inline])
forall st.
LocatorMap -> Parsec [Inline] st (String, String, [Inline])
pLocatorWords LocatorMap
locMap) "suffix" ([Inline] -> Either ParseError (String, String, [Inline]))
-> [Inline] -> Either ParseError (String, String, [Inline])
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
splitInp [Inline]
inp of
Right r :: (String, String, [Inline])
r -> (String, String, [Inline])
r
Left _ -> ("","",[Inline]
inp)
pLocatorWords :: LocatorMap -> Parsec [Inline] st (String, String, [Inline])
pLocatorWords :: LocatorMap -> Parsec [Inline] st (String, String, [Inline])
pLocatorWords locMap :: LocatorMap
locMap = do
ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity ())
-> ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity ()
forall a b. (a -> b) -> a -> b
$ String -> (Char -> Bool) -> ParsecT [Inline] st Identity Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar "," (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',')
ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Inline] st Identity Inline
forall st. Parsec [Inline] st Inline
pSpace
(la :: String
la, lo :: String
lo) <- LocatorMap -> Parsec [Inline] st (String, String)
forall st. LocatorMap -> Parsec [Inline] st (String, String)
pLocatorDelimited LocatorMap
locMap Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LocatorMap -> Parsec [Inline] st (String, String)
forall st. LocatorMap -> Parsec [Inline] st (String, String)
pLocatorIntegrated LocatorMap
locMap
[Inline]
s <- ParsecT [Inline] st Identity [Inline]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
(String, String, [Inline])
-> Parsec [Inline] st (String, String, [Inline])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
la, String -> String
trim String
lo, [Inline]
s)
pLocatorDelimited :: LocatorMap -> Parsec [Inline] st (String, String)
pLocatorDelimited :: LocatorMap -> Parsec [Inline] st (String, String)
pLocatorDelimited locMap :: LocatorMap
locMap = Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String))
-> Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String)
forall a b. (a -> b) -> a -> b
$ do
Inline
_ <- String -> (Char -> Bool) -> Parsec [Inline] st Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar "{" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '{')
Parsec [Inline] st Inline -> ParsecT [Inline] st Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany Parsec [Inline] st Inline
forall st. Parsec [Inline] st Inline
pSpace
(la :: String
la, _) <- LocatorMap -> Parsec [Inline] st (String, Bool)
forall st. LocatorMap -> Parsec [Inline] st (String, Bool)
pLocatorLabelDelimited LocatorMap
locMap
let inner :: ParsecT [Inline] u Identity (Bool, String)
inner = do { Inline
t <- ParsecT [Inline] u Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken; (Bool, String) -> ParsecT [Inline] u Identity (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify Inline
t) }
[(Bool, String)]
gs <- ParsecT [Inline] st Identity (Bool, String)
-> ParsecT [Inline] st Identity [(Bool, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([(Char, Char)]
-> ParsecT [Inline] st Identity (Bool, String)
-> ParsecT [Inline] st Identity (Bool, String)
forall st.
[(Char, Char)]
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
pBalancedBraces [('{','}'), ('[',']')] ParsecT [Inline] st Identity (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
inner)
Inline
_ <- String -> (Char -> Bool) -> Parsec [Inline] st Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar "}" (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '}')
let lo :: String
lo = ((Bool, String) -> String) -> [(Bool, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool, String) -> String
forall a b. (a, b) -> b
snd [(Bool, String)]
gs
(String, String) -> Parsec [Inline] st (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
la, String
lo)
pLocatorLabelDelimited :: LocatorMap -> Parsec [Inline] st (String, Bool)
pLocatorLabelDelimited :: LocatorMap -> Parsec [Inline] st (String, Bool)
pLocatorLabelDelimited locMap :: LocatorMap
locMap
= LocatorMap
-> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)
forall st.
LocatorMap
-> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)
pLocatorLabel' LocatorMap
locMap Parsec [Inline] st String
forall u. ParsecT [Inline] u Identity String
lim Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String, Bool) -> Parsec [Inline] st (String, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ("page", Bool
True)
where
lim :: ParsecT [Inline] u Identity String
lim = Text -> String
T.unpack (Text -> String) -> (Inline -> Text) -> Inline -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline -> String)
-> ParsecT [Inline] u Identity Inline
-> ParsecT [Inline] u Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Inline] u Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
pLocatorIntegrated :: LocatorMap -> Parsec [Inline] st (String, String)
pLocatorIntegrated :: LocatorMap -> Parsec [Inline] st (String, String)
pLocatorIntegrated locMap :: LocatorMap
locMap = Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String))
-> Parsec [Inline] st (String, String)
-> Parsec [Inline] st (String, String)
forall a b. (a -> b) -> a -> b
$ do
(la :: String
la, wasImplicit :: Bool
wasImplicit) <- LocatorMap -> Parsec [Inline] st (String, Bool)
forall st. LocatorMap -> Parsec [Inline] st (String, Bool)
pLocatorLabelIntegrated LocatorMap
locMap
let modifier :: (Bool, String) -> Parsec [Inline] st String
modifier = if Bool
wasImplicit
then (Bool, String) -> Parsec [Inline] st String
forall st. (Bool, String) -> Parsec [Inline] st String
requireDigits
else (Bool, String) -> Parsec [Inline] st String
forall st. (Bool, String) -> Parsec [Inline] st String
requireRomansOrDigits
String
g <- ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String)
-> ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String
forall a b. (a -> b) -> a -> b
$ Bool -> Parsec [Inline] st (Bool, String)
forall st. Bool -> Parsec [Inline] st (Bool, String)
pLocatorWordIntegrated (Bool -> Bool
not Bool
wasImplicit) Parsec [Inline] st (Bool, String)
-> ((Bool, String) -> ParsecT [Inline] st Identity String)
-> ParsecT [Inline] st Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, String) -> ParsecT [Inline] st Identity String
forall st. (Bool, String) -> Parsec [Inline] st String
modifier
[String]
gs <- ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String)
-> ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String
forall a b. (a -> b) -> a -> b
$ Bool -> Parsec [Inline] st (Bool, String)
forall st. Bool -> Parsec [Inline] st (Bool, String)
pLocatorWordIntegrated Bool
False Parsec [Inline] st (Bool, String)
-> ((Bool, String) -> ParsecT [Inline] st Identity String)
-> ParsecT [Inline] st Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, String) -> ParsecT [Inline] st Identity String
forall st. (Bool, String) -> Parsec [Inline] st String
modifier)
let lo :: String
lo = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String
gString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
gs)
(String, String) -> Parsec [Inline] st (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
la, String
lo)
pLocatorLabelIntegrated :: LocatorMap -> Parsec [Inline] st (String, Bool)
pLocatorLabelIntegrated :: LocatorMap -> Parsec [Inline] st (String, Bool)
pLocatorLabelIntegrated locMap :: LocatorMap
locMap
= LocatorMap
-> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)
forall st.
LocatorMap
-> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)
pLocatorLabel' LocatorMap
locMap Parsec [Inline] st String
forall u. ParsecT [Inline] u Identity String
lim Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parsec [Inline] st String -> Parsec [Inline] st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead Parsec [Inline] st String
forall u. ParsecT [Inline] u Identity String
digital Parsec [Inline] st String
-> Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String, Bool) -> Parsec [Inline] st (String, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ("page", Bool
True))
where
lim :: ParsecT [Inline] u Identity String
lim = ParsecT [Inline] u Identity String
-> ParsecT [Inline] u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] u Identity String
-> ParsecT [Inline] u Identity String)
-> ParsecT [Inline] u Identity String
-> ParsecT [Inline] u Identity String
forall a b. (a -> b) -> a -> b
$ Bool -> Parsec [Inline] u (Bool, String)
forall st. Bool -> Parsec [Inline] st (Bool, String)
pLocatorWordIntegrated Bool
True Parsec [Inline] u (Bool, String)
-> ((Bool, String) -> ParsecT [Inline] u Identity String)
-> ParsecT [Inline] u Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, String) -> ParsecT [Inline] u Identity String
forall st. (Bool, String) -> Parsec [Inline] st String
requireRomansOrDigits
digital :: ParsecT [Inline] u Identity String
digital = ParsecT [Inline] u Identity String
-> ParsecT [Inline] u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] u Identity String
-> ParsecT [Inline] u Identity String)
-> ParsecT [Inline] u Identity String
-> ParsecT [Inline] u Identity String
forall a b. (a -> b) -> a -> b
$ Bool -> Parsec [Inline] u (Bool, String)
forall st. Bool -> Parsec [Inline] st (Bool, String)
pLocatorWordIntegrated Bool
True Parsec [Inline] u (Bool, String)
-> ((Bool, String) -> ParsecT [Inline] u Identity String)
-> ParsecT [Inline] u Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool, String) -> ParsecT [Inline] u Identity String
forall st. (Bool, String) -> Parsec [Inline] st String
requireDigits
pLocatorLabel' :: LocatorMap -> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)
pLocatorLabel' :: LocatorMap
-> Parsec [Inline] st String -> Parsec [Inline] st (String, Bool)
pLocatorLabel' locMap :: LocatorMap
locMap lim :: Parsec [Inline] st String
lim = String -> Parsec [Inline] st (String, Bool)
go ""
where
go :: String -> Parsec [Inline] st (String, Bool)
go acc :: String
acc = Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool))
-> Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
forall a b. (a -> b) -> a -> b
$ do
Inline
t <- ParsecT [Inline] st Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
[Inline]
ts <- ParsecT [Inline] st Identity Inline
-> Parsec [Inline] st String
-> ParsecT [Inline] st Identity [Inline]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [Inline] st Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken (Parsec [Inline] st String -> Parsec [Inline] st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st String -> Parsec [Inline] st String)
-> Parsec [Inline] st String -> Parsec [Inline] st String
forall a b. (a -> b) -> a -> b
$ Parsec [Inline] st String -> Parsec [Inline] st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead Parsec [Inline] st String
lim)
let s :: String
s = String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline
tInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ts))
case String -> LocatorMap -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> String
trim String
s) LocatorMap
locMap of
Just l :: String
l -> String -> Parsec [Inline] st (String, Bool)
go String
s Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
-> Parsec [Inline] st (String, Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String, Bool) -> Parsec [Inline] st (String, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
l, Bool
False)
Nothing -> String -> Parsec [Inline] st (String, Bool)
go String
s
requireDigits :: (Bool, String) -> Parsec [Inline] st String
requireDigits :: (Bool, String) -> Parsec [Inline] st String
requireDigits (_, s :: String
s) = if Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isDigit String
s)
then String -> Parsec [Inline] st String
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail "requireDigits"
else String -> Parsec [Inline] st String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
requireRomansOrDigits :: (Bool, String) -> Parsec [Inline] st String
requireRomansOrDigits :: (Bool, String) -> Parsec [Inline] st String
requireRomansOrDigits (d :: Bool
d, s :: String
s) = if Bool -> Bool
not Bool
d
then String -> Parsec [Inline] st String
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail "requireRomansOrDigits"
else String -> Parsec [Inline] st String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
pLocatorWordIntegrated :: Bool -> Parsec [Inline] st (Bool, String)
pLocatorWordIntegrated :: Bool -> Parsec [Inline] st (Bool, String)
pLocatorWordIntegrated isFirst :: Bool
isFirst = Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String))
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall a b. (a -> b) -> a -> b
$ do
Text
punct <- if Bool
isFirst
then Text -> ParsecT [Inline] st Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return ""
else (Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline -> Text)
-> ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Inline] st Identity Inline
forall st. Parsec [Inline] st Inline
pLocatorSep) ParsecT [Inline] st Identity Text
-> ParsecT [Inline] st Identity Text
-> ParsecT [Inline] st Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ParsecT [Inline] st Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return ""
String
sp <- String
-> ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (ParsecT [Inline] st Identity Inline
forall st. Parsec [Inline] st Inline
pSpace ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT [Inline] st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return " ")
(dig :: Bool
dig, s :: String
s) <- [(Char, Char)]
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall st.
[(Char, Char)]
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
pBalancedBraces [('(',')'), ('[',']'), ('{','}')] Parsec [Inline] st (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
pPageSeq
(Bool, String) -> Parsec [Inline] st (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
dig, Text -> String
T.unpack Text
punct String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
pBalancedBraces :: [(Char, Char)] -> Parsec [Inline] st (Bool, String) -> Parsec [Inline] st (Bool, String)
pBalancedBraces :: [(Char, Char)]
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
pBalancedBraces braces :: [(Char, Char)]
braces p :: Parsec [Inline] st (Bool, String)
p = Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String))
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall a b. (a -> b) -> a -> b
$ do
[(Bool, String)]
ss <- Parsec [Inline] st (Bool, String)
-> ParsecT [Inline] st Identity [(Bool, String)]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 Parsec [Inline] st (Bool, String)
surround
(Bool, String) -> Parsec [Inline] st (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, String) -> Parsec [Inline] st (Bool, String))
-> (Bool, String) -> Parsec [Inline] st (Bool, String)
forall a b. (a -> b) -> a -> b
$ [(Bool, String)] -> (Bool, String)
anyWereDigitLike [(Bool, String)]
ss
where
except :: Parsec [Inline] st (Bool, String)
except = ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Inline] st Identity Inline
forall st. Parsec [Inline] st Inline
pBraces ParsecT [Inline] st Identity ()
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parsec [Inline] st (Bool, String)
p
surround :: Parsec [Inline] st (Bool, String)
surround = (Parsec [Inline] st (Bool, String)
-> (Char, Char) -> Parsec [Inline] st (Bool, String))
-> Parsec [Inline] st (Bool, String)
-> [(Char, Char)]
-> Parsec [Inline] st (Bool, String)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a :: Parsec [Inline] st (Bool, String)
a (open :: Char
open, close :: Char
close) -> Char
-> Char
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall u.
Char
-> Char
-> ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
sur Char
open Char
close Parsec [Inline] st (Bool, String)
except Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec [Inline] st (Bool, String)
a) Parsec [Inline] st (Bool, String)
except [(Char, Char)]
braces
isc :: Char -> ParsecT [Inline] st Identity Text
isc c :: Char
c = Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inline -> Text)
-> ParsecT [Inline] st Identity Inline
-> ParsecT [Inline] st Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (Char -> Bool) -> ParsecT [Inline] st Identity Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar [Char
c] (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
sur :: Char
-> Char
-> ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
sur c :: Char
c c' :: Char
c' m :: ParsecT [Inline] u Identity (Bool, String)
m = ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String))
-> ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall a b. (a -> b) -> a -> b
$ do
(d :: Bool
d, mid :: String
mid) <- ParsecT [Inline] u Identity Text
-> ParsecT [Inline] u Identity Text
-> ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT [Inline] u Identity Text
forall st. Char -> ParsecT [Inline] st Identity Text
isc Char
c) (Char -> ParsecT [Inline] u Identity Text
forall st. Char -> ParsecT [Inline] st Identity Text
isc Char
c') ((Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Bool
False, "") ParsecT [Inline] u Identity (Bool, String)
m)
(Bool, String) -> ParsecT [Inline] u Identity (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
d, [Char
c] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
mid String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c'])
flattened :: String
flattened = ((Char, Char) -> String) -> [(Char, Char)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(o :: Char
o, c :: Char
c) -> [Char
o, Char
c]) [(Char, Char)]
braces
pBraces :: Parsec [Inline] st Inline
pBraces = String -> (Char -> Bool) -> Parsec [Inline] st Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar "braces" (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
flattened)
pPageSeq :: Parsec [Inline] st (Bool, String)
pPageSeq :: Parsec [Inline] st (Bool, String)
pPageSeq = Parsec [Inline] st (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
oneDotTwo Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec [Inline] st (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
withPeriod
where
oneDotTwo :: ParsecT [Inline] st Identity (Bool, String)
oneDotTwo = do
(Bool, String)
u <- ParsecT [Inline] st Identity (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
pPageUnit
[(Bool, String)]
us <- ParsecT [Inline] st Identity (Bool, String)
-> ParsecT [Inline] st Identity [(Bool, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Inline] st Identity (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
withPeriod
(Bool, String) -> ParsecT [Inline] st Identity (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, String) -> ParsecT [Inline] st Identity (Bool, String))
-> (Bool, String) -> ParsecT [Inline] st Identity (Bool, String)
forall a b. (a -> b) -> a -> b
$ [(Bool, String)] -> (Bool, String)
anyWereDigitLike ((Bool, String)
u(Bool, String) -> [(Bool, String)] -> [(Bool, String)]
forall a. a -> [a] -> [a]
:[(Bool, String)]
us)
withPeriod :: ParsecT [Inline] u Identity (Bool, String)
withPeriod = ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String))
-> ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall a b. (a -> b) -> a -> b
$ do
Inline
p <- String -> (Char -> Bool) -> Parsec [Inline] u Inline
forall st. String -> (Char -> Bool) -> Parsec [Inline] st Inline
pMatchChar "." (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.')
(Bool, String)
u <- ParsecT [Inline] u Identity (Bool, String)
-> ParsecT [Inline] u Identity (Bool, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT [Inline] u Identity (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
pPageUnit
(Bool, String) -> ParsecT [Inline] u Identity (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, String) -> Bool
forall a b. (a, b) -> a
fst (Bool, String)
u, Text -> String
T.unpack (Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify Inline
p) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Bool, String) -> String
forall a b. (a, b) -> b
snd (Bool, String)
u)
anyWereDigitLike :: [(Bool, String)] -> (Bool, String)
anyWereDigitLike :: [(Bool, String)] -> (Bool, String)
anyWereDigitLike as :: [(Bool, String)]
as = (((Bool, String) -> Bool) -> [(Bool, String)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool, String) -> Bool
forall a b. (a, b) -> a
fst [(Bool, String)]
as, ((Bool, String) -> String) -> [(Bool, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool, String) -> String
forall a b. (a, b) -> b
snd [(Bool, String)]
as)
pPageUnit :: Parsec [Inline] st (Bool, String)
pPageUnit :: Parsec [Inline] st (Bool, String)
pPageUnit = Parsec [Inline] st (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
roman Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
-> Parsec [Inline] st (Bool, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec [Inline] st (Bool, String)
forall u. ParsecT [Inline] u Identity (Bool, String)
plainUnit
where
roman :: ParsecT [Inline] st Identity (Bool, String)
roman = (Bool
True,) (String -> (Bool, String))
-> ParsecT [Inline] st Identity String
-> ParsecT [Inline] st Identity (Bool, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Inline] st Identity String
forall u. ParsecT [Inline] u Identity String
pRoman
plainUnit :: ParsecT [Inline] u Identity (Bool, String)
plainUnit = do
[Inline]
ts <- ParsecT [Inline] u Identity Inline
-> ParsecT [Inline] u Identity [Inline]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Inline] u Identity Inline
-> ParsecT [Inline] u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Inline] u Identity Inline
forall st. Parsec [Inline] st Inline
pSpace ParsecT [Inline] u Identity ()
-> ParsecT [Inline] u Identity () -> ParsecT [Inline] u Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
ParsecT [Inline] u Identity Inline
-> ParsecT [Inline] u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Inline] u Identity Inline
forall st. Parsec [Inline] st Inline
pLocatorPunct ParsecT [Inline] u Identity ()
-> ParsecT [Inline] u Identity Inline
-> ParsecT [Inline] u Identity Inline
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
ParsecT [Inline] u Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken)
let s :: String
s = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ts
(Bool, String) -> ParsecT [Inline] u Identity (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isDigit String
s, String
s)
pRoman :: Parsec [Inline] st String
pRoman :: Parsec [Inline] st String
pRoman = Parsec [Inline] st String -> Parsec [Inline] st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec [Inline] st String -> Parsec [Inline] st String)
-> Parsec [Inline] st String -> Parsec [Inline] st String
forall a b. (a -> b) -> a -> b
$ do
Inline
t <- ParsecT [Inline] st Identity Inline
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
case Inline
t of
Str xs :: Text
xs -> case String -> Maybe Int
parseRomanNumeral (Text -> String
T.unpack Text
xs) of
Nothing -> Parsec [Inline] st String
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just _ -> String -> Parsec [Inline] st String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parsec [Inline] st String)
-> String -> Parsec [Inline] st String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
xs
_ -> Parsec [Inline] st String
forall (m :: * -> *) a. MonadPlus m => m a
mzero
isLocatorPunct :: Char -> Bool
isLocatorPunct :: Char -> Bool
isLocatorPunct '-' = Bool
False
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 String String
locatorMap :: Style -> LocatorMap
locatorMap :: Style -> LocatorMap
locatorMap sty :: Style
sty =
(CslTerm -> LocatorMap -> LocatorMap)
-> LocatorMap -> [CslTerm] -> LocatorMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\term :: CslTerm
term -> String -> String -> LocatorMap -> LocatorMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (CslTerm -> String
termSingular CslTerm
term) (CslTerm -> String
cslTerm CslTerm
term)
(LocatorMap -> LocatorMap)
-> (LocatorMap -> LocatorMap) -> LocatorMap -> LocatorMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> LocatorMap -> LocatorMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (CslTerm -> String
termPlural CslTerm
term) (CslTerm -> String
cslTerm CslTerm
term))
LocatorMap
forall k a. Map k a
M.empty
((Locale -> [CslTerm]) -> [Locale] -> [CslTerm]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Locale -> [CslTerm]
localeTerms ([Locale] -> [CslTerm]) -> [Locale] -> [CslTerm]
forall a b. (a -> b) -> a -> b
$ Style -> [Locale]
styleLocale Style
sty)