{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
module Text.CSL.Proc.Collapse where
import Prelude
import Control.Arrow (second, (&&&), (>>>))
import Data.Char
import Data.List (groupBy, sortBy)
import Data.Monoid (Any (..))
import Data.Ord (comparing)
import qualified Data.Text as T
import Text.CSL.Eval
import Text.CSL.Proc.Disamb
import Text.CSL.Style hiding (Any)
import Text.CSL.Util (orIfNull, proc, proc', query)
import Text.Pandoc.Definition (Inline (Str))
collapseCitGroups :: Style -> [CitationGroup] -> [CitationGroup]
collapseCitGroups :: Style -> [CitationGroup] -> [CitationGroup]
collapseCitGroups s :: Style
s
= (CitationGroup -> CitationGroup)
-> [CitationGroup] -> [CitationGroup]
forall a b. (a -> b) -> [a] -> [b]
map CitationGroup -> CitationGroup
doCollapse
where
doCollapse :: CitationGroup -> CitationGroup
doCollapse = case Style -> [String]
getCollapseOptions Style
s of
"year" : _ -> Style -> String -> CitationGroup -> CitationGroup
collapseYear Style
s []
"year-suffix" : _ -> Style -> String -> CitationGroup -> CitationGroup
collapseYear Style
s "year-suffix"
"year-suffix-ranged" : _ -> Style -> String -> CitationGroup -> CitationGroup
collapseYear Style
s "year-suffix-ranged"
"citation-number" : _ -> CitationGroup -> CitationGroup
collapseNumber
_ -> CitationGroup -> CitationGroup
forall a. a -> a
id
getCollapseOptions :: Style -> [String]
getCollapseOptions :: Style -> [String]
getCollapseOptions
= ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd ([(String, String)] -> [String])
-> (Style -> [(String, String)]) -> Style -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) "collapse" (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) ([(String, String)] -> [(String, String)])
-> (Style -> [(String, String)]) -> Style -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [(String, String)]
citOptions (Citation -> [(String, String)])
-> (Style -> Citation) -> Style -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Citation
citation
collapseNumber :: CitationGroup -> CitationGroup
collapseNumber :: CitationGroup -> CitationGroup
collapseNumber (CG _ f :: Formatting
f d :: String
d os :: [(Cite, Output)]
os) = ([Output] -> [Output]) -> CitationGroup -> CitationGroup
mapCitationGroup [Output] -> [Output]
process (CitationGroup -> CitationGroup) -> CitationGroup -> CitationGroup
forall a b. (a -> b) -> a -> b
$ [(Cite, Output)]
-> Formatting -> String -> [(Cite, Output)] -> CitationGroup
CG [] Formatting
f String
d [(Cite, Output)]
os
where
hasLocator :: [Output] -> Bool
hasLocator = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> ([Output] -> [Bool]) -> [Output] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output -> [Bool]) -> [Output] -> [Bool]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [Bool]
hasLocator'
hasLocator' :: Output -> [Bool]
hasLocator' o :: Output
o
| OLoc _ _ <- Output
o = [Bool
True]
| Bool
otherwise = [Bool
False]
citNums :: Output -> [Int]
citNums (OCitNum i :: Int
i _) = [Int
i]
citNums (Output xs :: [Output]
xs _) = (Output -> [Int]) -> [Output] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Output -> [Int]
citNums [Output]
xs
citNums _ = []
numOf :: Output -> Int
numOf = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a b. a -> b -> a
const 0 ([Int] -> Int) -> (Output -> [Int]) -> Output -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output -> [Int]
citNums
process :: [Output] -> [Output]
process xs :: [Output]
xs = if [Output] -> Bool
hasLocator [Output]
xs
then [Output]
xs
else (([Output] -> [Output]) -> [[Output]] -> [Output])
-> [[Output]] -> ([Output] -> [Output]) -> [Output]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Output] -> [Output]) -> [[Output]] -> [Output]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Output -> Int) -> [Output] -> [[Output]]
forall a. (a -> Int) -> [a] -> [[a]]
groupConsecWith Output -> Int
numOf [Output]
xs)
(([Output] -> [Output]) -> [Output])
-> ([Output] -> [Output]) -> [Output]
forall a b. (a -> b) -> a -> b
$ \ys :: [Output]
ys ->
if [Output] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output]
ys Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 2
then [ [Output] -> Formatting -> Output
Output [
[Output] -> Output
forall a. [a] -> a
head [Output]
ys
, [Inline] -> Output
OPan [Text -> Inline
Str "\x2013"]
, [Output] -> Output
forall a. [a] -> a
last [Output]
ys
] Formatting
emptyFormatting
]
else [Output]
ys
groupCites :: [(Cite, Output)] -> [(Cite, Output)]
groupCites :: [(Cite, Output)] -> [(Cite, Output)]
groupCites [] = []
groupCites (x :: (Cite, Output)
x:xs :: [(Cite, Output)]
xs) = let equal :: [(Cite, Output)]
equal = ((Cite, Output) -> Bool) -> [(Cite, Output)] -> [(Cite, Output)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Cite, Output) -> (Cite, Output) -> Bool
forall b b a a. (Data b, Data b) => (a, b) -> (a, b) -> Bool
hasSameNamesAs (Cite, Output)
x) [(Cite, Output)]
xs
notequal :: [(Cite, Output)]
notequal = ((Cite, Output) -> Bool) -> [(Cite, Output)] -> [(Cite, Output)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Cite, Output) -> Bool) -> (Cite, Output) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cite, Output) -> (Cite, Output) -> Bool
forall b b a a. (Data b, Data b) => (a, b) -> (a, b) -> Bool
hasSameNamesAs (Cite, Output)
x) [(Cite, Output)]
xs
in (Cite, Output)
x (Cite, Output) -> [(Cite, Output)] -> [(Cite, Output)]
forall a. a -> [a] -> [a]
: [(Cite, Output)]
equal [(Cite, Output)] -> [(Cite, Output)] -> [(Cite, Output)]
forall a. [a] -> [a] -> [a]
++ [(Cite, Output)] -> [(Cite, Output)]
groupCites [(Cite, Output)]
notequal
where
hasSameNamesAs :: (a, b) -> (a, b) -> Bool
hasSameNamesAs w :: (a, b)
w y :: (a, b)
y = b -> [Output]
forall b. Data b => b -> [Output]
namesOf ((a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
w) [Output] -> [Output] -> Bool
forall a. Eq a => a -> a -> Bool
== b -> [Output]
forall b. Data b => b -> [Output]
namesOf ((a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
y)
contribsQ :: Output -> [[Output]]
contribsQ o :: Output
o
| OContrib _ _ c :: [Output]
c _ _ <- Output
o = [[Output]
c]
| Bool
otherwise = []
namesOf :: b -> [Output]
namesOf y :: b
y = case (Output -> [[Output]]) -> b -> [[Output]]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [[Output]]
contribsQ b
y of
[] -> []
(z :: [Output]
z:_) -> (Output -> Output) -> [Output] -> [Output]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Output -> Output
rmHashAndGivenNames [Output]
z
getYearAndSuf :: Output -> Output
getYearAndSuf :: Output -> Output
getYearAndSuf x :: Output
x
= case ([Output] -> [Output]) -> Output -> [Output]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query [Output] -> [Output]
getOYear Output
x of
[] -> Output
noOutputError
x' :: [Output]
x' -> [Output] -> Formatting -> Output
Output [Output]
x' Formatting
emptyFormatting
where
getOYear :: [Output] -> [Output]
getOYear o :: [Output]
o
| OYear {} : _ <- [Output]
o = [[Output] -> Output
forall a. [a] -> a
head [Output]
o]
| OYearSuf {} : _ <- [Output]
o = [[Output] -> Output
forall a. [a] -> a
head [Output]
o]
| OLoc {} : _ <- [Output]
o = [[Output] -> Output
forall a. [a] -> a
head [Output]
o]
| ODel _ : OLoc {} : _ <- [Output]
o = [[Output] -> Output
forall a. [a] -> a
head [Output]
o]
| OStatus {} : _ <- [Output]
o = [[Output] -> Output
forall a. [a] -> a
head [Output]
o]
| Bool
otherwise = []
collapseYear :: Style -> String -> CitationGroup -> CitationGroup
collapseYear :: Style -> String -> CitationGroup -> CitationGroup
collapseYear s :: Style
s ranged :: String
ranged (CG cs :: [(Cite, Output)]
cs f :: Formatting
f d :: String
d os :: [(Cite, Output)]
os) = [(Cite, Output)]
-> Formatting -> String -> [(Cite, Output)] -> CitationGroup
CG [(Cite, Output)]
cs Formatting
f [] ([(Cite, Output)] -> [(Cite, Output)]
process [(Cite, Output)]
os)
where
styleYSD :: String
styleYSD = String -> [(String, String)] -> String
getOptionVal "year-suffix-delimiter" ([(String, String)] -> String)
-> (Style -> [(String, String)]) -> Style -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [(String, String)]
citOptions (Citation -> [(String, String)])
-> (Style -> Citation) -> Style -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Citation
citation (Style -> String) -> Style -> String
forall a b. (a -> b) -> a -> b
$ Style
s
yearSufDel :: String
yearSufDel = String
styleYSD String -> String -> String
forall a. [a] -> [a] -> [a]
`orIfNull` (Layout -> String
layDelim (Layout -> String) -> (Style -> Layout) -> Style -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Layout
citLayout (Citation -> Layout) -> (Style -> Citation) -> Style -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Citation
citation (Style -> String) -> Style -> String
forall a b. (a -> b) -> a -> b
$ Style
s)
afterCD :: String
afterCD = String -> [(String, String)] -> String
getOptionVal "after-collapse-delimiter" ([(String, String)] -> String)
-> (Style -> [(String, String)]) -> Style -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [(String, String)]
citOptions (Citation -> [(String, String)])
-> (Style -> Citation) -> Style -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Citation
citation (Style -> String) -> Style -> String
forall a b. (a -> b) -> a -> b
$ Style
s
afterColDel :: String
afterColDel = String
afterCD String -> String -> String
forall a. [a] -> [a] -> [a]
`orIfNull` String
d
format :: [Output] -> [Output]
format [] = []
format (x :: Output
x:xs :: [Output]
xs) = Output
x Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: (Output -> Output) -> [Output] -> [Output]
forall a b. (a -> b) -> [a] -> [b]
map Output -> Output
getYearAndSuf [Output]
xs
isRanged :: Bool
isRanged = case String
ranged of
"year-suffix-ranged" -> Bool
True
_ -> Bool
False
collapseRange :: [(Cite, Output)] -> [Output]
collapseRange = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ranged then ((Cite, Output) -> Output) -> [(Cite, Output)] -> [Output]
forall a b. (a -> b) -> [a] -> [b]
map ((Cite -> Output -> Output) -> (Cite, Output) -> Output
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Cite -> Output -> Output
addCiteAffixes)
else Bool -> String -> [(Cite, Output)] -> [Output]
collapseYearSuf Bool
isRanged String
yearSufDel
rmAffixes :: Cite -> Cite
rmAffixes x :: Cite
x = Cite
x {citePrefix :: Formatted
citePrefix = Formatted
forall a. Monoid a => a
mempty, citeSuffix :: Formatted
citeSuffix = Formatted
forall a. Monoid a => a
mempty}
delim :: String
delim = let d' :: String
d' = String -> [(String, String)] -> String
getOptionVal "cite-group-delimiter" ([(String, String)] -> String)
-> (Style -> [(String, String)]) -> Style -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [(String, String)]
citOptions (Citation -> [(String, String)])
-> (Style -> Citation) -> Style -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Citation
citation (Style -> String) -> Style -> String
forall a b. (a -> b) -> a -> b
$ Style
s
in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
d' then ", " else String
d'
collapsYS :: [(Cite, Output)] -> (Cite, Output)
collapsYS a :: [(Cite, Output)]
a = case [(Cite, Output)]
a of
[] -> (Cite
emptyCite, Output
ONull)
[x :: (Cite, Output)
x] -> Cite -> Cite
rmAffixes (Cite -> Cite)
-> ((Cite, Output) -> Cite) -> (Cite, Output) -> Cite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cite, Output) -> Cite
forall a b. (a, b) -> a
fst ((Cite, Output) -> Cite)
-> ((Cite, Output) -> Output) -> (Cite, Output) -> (Cite, Output)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Cite -> Output -> Output) -> (Cite, Output) -> Output
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Cite -> Output -> Output
addCiteAffixes ((Cite, Output) -> (Cite, Output))
-> (Cite, Output) -> (Cite, Output)
forall a b. (a -> b) -> a -> b
$ (Cite, Output)
x
_ -> (,) (Cite -> Cite
rmAffixes (Cite -> Cite) -> Cite -> Cite
forall a b. (a -> b) -> a -> b
$ (Cite, Output) -> Cite
forall a b. (a, b) -> a
fst ((Cite, Output) -> Cite) -> (Cite, Output) -> Cite
forall a b. (a -> b) -> a -> b
$ [(Cite, Output)] -> (Cite, Output)
forall a. [a] -> a
head [(Cite, Output)]
a) (Output -> (Cite, Output))
-> ([(Cite, Output)] -> Output)
-> [(Cite, Output)]
-> (Cite, Output)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Output] -> Formatting -> Output)
-> Formatting -> [Output] -> Output
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Output] -> Formatting -> Output
Output Formatting
emptyFormatting ([Output] -> Output)
-> ([(Cite, Output)] -> [Output]) -> [(Cite, Output)] -> Output
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> [Output] -> [Output]
addDelim String
delim ([Output] -> [Output])
-> ([(Cite, Output)] -> [Output]) -> [(Cite, Output)] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Cite, Output)] -> [Output]
collapseRange ([(Cite, Output)] -> [Output])
-> ([(Cite, Output)] -> [(Cite, Output)])
-> [(Cite, Output)]
-> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
([Cite] -> [Output] -> [(Cite, Output)])
-> ([Cite], [Output]) -> [(Cite, Output)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Cite] -> [Output] -> [(Cite, Output)]
forall a b. [a] -> [b] -> [(a, b)]
zip (([Cite], [Output]) -> [(Cite, Output)])
-> ([(Cite, Output)] -> ([Cite], [Output]))
-> [(Cite, Output)]
-> [(Cite, Output)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Output] -> [Output]) -> ([Cite], [Output]) -> ([Cite], [Output])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Output] -> [Output]
format (([Cite], [Output]) -> ([Cite], [Output]))
-> ([(Cite, Output)] -> ([Cite], [Output]))
-> [(Cite, Output)]
-> ([Cite], [Output])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Cite, Output)] -> ([Cite], [Output])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Cite, Output)] -> (Cite, Output))
-> [(Cite, Output)] -> (Cite, Output)
forall a b. (a -> b) -> a -> b
$ [(Cite, Output)]
a
doCollapse :: [[(Cite, Output)]] -> [(Cite, Output)]
doCollapse [] = []
doCollapse [x :: [(Cite, Output)]
x] = [[(Cite, Output)] -> (Cite, Output)
collapsYS [(Cite, Output)]
x]
doCollapse (x :: [(Cite, Output)]
x:xs :: [[(Cite, Output)]]
xs) = let (a :: Cite
a,b :: Output
b) = [(Cite, Output)] -> (Cite, Output)
collapsYS [(Cite, Output)]
x
in if [(Cite, Output)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Cite, Output)]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1
then (Cite
a, [Output] -> Formatting -> Output
Output (Output
b Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [String -> Output
ODel String
afterColDel]) Formatting
emptyFormatting) (Cite, Output) -> [(Cite, Output)] -> [(Cite, Output)]
forall a. a -> [a] -> [a]
: [[(Cite, Output)]] -> [(Cite, Output)]
doCollapse [[(Cite, Output)]]
xs
else (Cite
a, [Output] -> Formatting -> Output
Output (Output
b Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [String -> Output
ODel String
d ]) Formatting
emptyFormatting) (Cite, Output) -> [(Cite, Output)] -> [(Cite, Output)]
forall a. a -> [a] -> [a]
: [[(Cite, Output)]] -> [(Cite, Output)]
doCollapse [[(Cite, Output)]]
xs
contribsQ :: Output -> [[Output]]
contribsQ o :: Output
o
| OContrib _ _ c :: [Output]
c _ _ <- Output
o = [(Output -> Output) -> [Output] -> [Output]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc' Output -> Output
rmHashAndGivenNames [Output]
c]
| Bool
otherwise = []
namesOf :: Output -> [[Output]]
namesOf = (Output -> [[Output]]) -> Output -> [[Output]]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [[Output]]
contribsQ
hasSameNames :: (a, Output) -> (a, Output) -> Bool
hasSameNames a :: (a, Output)
a b :: (a, Output)
b = Bool -> Bool
not ([[Output]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Output -> [[Output]]
namesOf ((a, Output) -> Output
forall a b. (a, b) -> b
snd (a, Output)
a))) Bool -> Bool -> Bool
&&
Output -> [[Output]]
namesOf ((a, Output) -> Output
forall a b. (a, b) -> b
snd (a, Output)
a) [[Output]] -> [[Output]] -> Bool
forall a. Eq a => a -> a -> Bool
== Output -> [[Output]]
namesOf ((a, Output) -> Output
forall a b. (a, b) -> b
snd (a, Output)
b)
process :: [(Cite, Output)] -> [(Cite, Output)]
process = [[(Cite, Output)]] -> [(Cite, Output)]
doCollapse ([[(Cite, Output)]] -> [(Cite, Output)])
-> ([(Cite, Output)] -> [[(Cite, Output)]])
-> [(Cite, Output)]
-> [(Cite, Output)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Cite, Output) -> (Cite, Output) -> Bool)
-> [(Cite, Output)] -> [[(Cite, Output)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Cite, Output) -> (Cite, Output) -> Bool
forall a a. (a, Output) -> (a, Output) -> Bool
hasSameNames ([(Cite, Output)] -> [[(Cite, Output)]])
-> ([(Cite, Output)] -> [(Cite, Output)])
-> [(Cite, Output)]
-> [[(Cite, Output)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Cite, Output)] -> [(Cite, Output)]
groupCites
collapseYearSuf :: Bool -> String -> [(Cite,Output)] -> [Output]
collapseYearSuf :: Bool -> String -> [(Cite, Output)] -> [Output]
collapseYearSuf ranged :: Bool
ranged ysd :: String
ysd = [(Cite, Output)] -> [Output]
process
where
yearOf :: Output -> String
yearOf = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (Output -> [String]) -> Output -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output -> [String]) -> Output -> [String]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [String]
getYear
getYear :: Output -> [String]
getYear o :: Output
o
| OYear y :: String
y _ _ <- Output
o = [String
y]
| Bool
otherwise = []
processYS :: [Output] -> [Output]
processYS = if Bool
ranged then [Output] -> [Output]
collapseYearSufRanged else [Output] -> [Output]
forall a. a -> a
id
process :: [(Cite, Output)] -> [Output]
process = ([(Cite, Output)] -> Output) -> [[(Cite, Output)]] -> [Output]
forall a b. (a -> b) -> [a] -> [b]
map (([Output] -> Formatting -> Output)
-> Formatting -> [Output] -> Output
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Output] -> Formatting -> Output
Output Formatting
emptyFormatting ([Output] -> Output)
-> ([(Cite, Output)] -> [Output]) -> [(Cite, Output)] -> Output
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Cite, Output)] -> [Output]
getYS) ([[(Cite, Output)]] -> [Output])
-> ([(Cite, Output)] -> [[(Cite, Output)]])
-> [(Cite, Output)]
-> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Cite, Output) -> (Cite, Output) -> Bool)
-> [(Cite, Output)] -> [[(Cite, Output)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Cite, Output) -> (Cite, Output) -> Bool
comp
checkAffix :: Formatted -> Bool
checkAffix (Formatted []) = Bool
True
checkAffix _ = Bool
False
comp :: (Cite, Output) -> (Cite, Output) -> Bool
comp a :: (Cite, Output)
a b :: (Cite, Output)
b = Output -> String
yearOf ((Cite, Output) -> Output
forall a b. (a, b) -> b
snd (Cite, Output)
a) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Output -> String
yearOf ((Cite, Output) -> Output
forall a b. (a, b) -> b
snd (Cite, Output)
b) Bool -> Bool -> Bool
&&
Formatted -> Bool
checkAffix (Cite -> Formatted
citePrefix (Cite -> Formatted) -> Cite -> Formatted
forall a b. (a -> b) -> a -> b
$ (Cite, Output) -> Cite
forall a b. (a, b) -> a
fst (Cite, Output)
a) Bool -> Bool -> Bool
&&
Formatted -> Bool
checkAffix (Cite -> Formatted
citeSuffix (Cite -> Formatted) -> Cite -> Formatted
forall a b. (a -> b) -> a -> b
$ (Cite, Output) -> Cite
forall a b. (a, b) -> a
fst (Cite, Output)
a) Bool -> Bool -> Bool
&&
Formatted -> Bool
checkAffix (Cite -> Formatted
citePrefix (Cite -> Formatted) -> Cite -> Formatted
forall a b. (a -> b) -> a -> b
$ (Cite, Output) -> Cite
forall a b. (a, b) -> a
fst (Cite, Output)
b) Bool -> Bool -> Bool
&&
Formatted -> Bool
checkAffix (Cite -> Formatted
citeSuffix (Cite -> Formatted) -> Cite -> Formatted
forall a b. (a -> b) -> a -> b
$ (Cite, Output) -> Cite
forall a b. (a, b) -> a
fst (Cite, Output)
b) Bool -> Bool -> Bool
&&
String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Cite -> String
citeLocator (Cite -> String) -> Cite -> String
forall a b. (a -> b) -> a -> b
$ (Cite, Output) -> Cite
forall a b. (a, b) -> a
fst (Cite, Output)
a) Bool -> Bool -> Bool
&&
String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Cite -> String
citeLocator (Cite -> String) -> Cite -> String
forall a b. (a -> b) -> a -> b
$ (Cite, Output) -> Cite
forall a b. (a, b) -> a
fst (Cite, Output)
b)
getYS :: [(Cite, Output)] -> [Output]
getYS [] = []
getYS [x :: (Cite, Output)
x] = Output -> [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> [Output]) -> Output -> [Output]
forall a b. (a -> b) -> a -> b
$ (Cite -> Output -> Output) -> (Cite, Output) -> Output
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Cite -> Output -> Output
addCiteAffixes (Cite, Output)
x
getYS (x :: (Cite, Output)
x:xs :: [(Cite, Output)]
xs) = if Bool
ranged
then (Output -> Output) -> Output -> Output
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Output -> Output
rmOYearSuf ((Cite, Output) -> Output
forall a b. (a, b) -> b
snd (Cite, Output)
x) Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: String -> [Output] -> [Output]
addDelim String
ysd ([Output] -> [Output]
processYS ([Output] -> [Output]) -> [Output] -> [Output]
forall a b. (a -> b) -> a -> b
$ (Cite, Output) -> Output
forall a b. (a, b) -> b
snd (Cite, Output)
x Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: (Output -> [Output]) -> [Output] -> [Output]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [Output]
rmOYear (((Cite, Output) -> Output) -> [(Cite, Output)] -> [Output]
forall a b. (a -> b) -> [a] -> [b]
map (Cite, Output) -> Output
forall a b. (a, b) -> b
snd [(Cite, Output)]
xs))
else String -> [Output] -> [Output]
addDelim String
ysd ([Output] -> [Output]) -> [Output] -> [Output]
forall a b. (a -> b) -> a -> b
$ (Cite, Output) -> Output
forall a b. (a, b) -> b
snd (Cite, Output)
x Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [Output] -> [Output]
processYS ((Output -> [Output]) -> [Output] -> [Output]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [Output]
rmOYear (((Cite, Output) -> Output) -> [(Cite, Output)] -> [Output]
forall a b. (a -> b) -> [a] -> [b]
map (Cite, Output) -> Output
forall a b. (a, b) -> b
snd [(Cite, Output)]
xs))
rmOYearSuf :: Output -> Output
rmOYearSuf o :: Output
o
| OYearSuf {} <- Output
o = Output
ONull
| Bool
otherwise = Output
o
rmOYear :: Output -> [Output]
rmOYear o :: Output
o
| OYearSuf {} <- Output
o = [Output
o]
| Bool
otherwise = []
collapseYearSufRanged :: [Output] -> [Output]
collapseYearSufRanged :: [Output] -> [Output]
collapseYearSufRanged = [Output] -> [Output]
process
where
getOYS :: Output -> [(Int, Formatting)]
getOYS o :: Output
o
| OYearSuf s :: String
s _ _ f :: Formatting
f <- Output
o = [(if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= [] then Char -> Int
ord (String -> Char
forall a. [a] -> a
head String
s) else 0, Formatting
f)]
| Bool
otherwise = []
sufOf :: Output -> (Int, Formatting)
sufOf = ((Int, Formatting) -> (Int, Formatting) -> (Int, Formatting))
-> (Int, Formatting) -> [(Int, Formatting)] -> (Int, Formatting)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Formatting) -> (Int, Formatting) -> (Int, Formatting)
forall a b. a -> b -> a
const (0,Formatting
emptyFormatting) ([(Int, Formatting)] -> (Int, Formatting))
-> (Output -> [(Int, Formatting)]) -> Output -> (Int, Formatting)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output -> [(Int, Formatting)]) -> Output -> [(Int, Formatting)]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [(Int, Formatting)]
getOYS
newSuf :: [Output] -> [([Int], Formatting)]
newSuf = (Output -> (Int, Formatting)) -> [Output] -> [(Int, Formatting)]
forall a b. (a -> b) -> [a] -> [b]
map Output -> (Int, Formatting)
sufOf ([Output] -> [(Int, Formatting)])
-> ([(Int, Formatting)] -> [([Int], Formatting)])
-> [Output]
-> [([Int], Formatting)]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (((Int, Formatting) -> Int) -> [(Int, Formatting)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Formatting) -> Int
forall a b. (a, b) -> a
fst ([(Int, Formatting)] -> [Int])
-> ([Int] -> [[Int]]) -> [(Int, Formatting)] -> [[Int]]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Int] -> [[Int]]
groupConsec) ([(Int, Formatting)] -> [[Int]])
-> ([(Int, Formatting)] -> [Formatting])
-> [(Int, Formatting)]
-> ([[Int]], [Formatting])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Int, Formatting) -> Formatting)
-> [(Int, Formatting)] -> [Formatting]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Formatting) -> Formatting
forall a b. (a, b) -> b
snd ([(Int, Formatting)] -> ([[Int]], [Formatting]))
-> (([[Int]], [Formatting]) -> [([Int], Formatting)])
-> [(Int, Formatting)]
-> [([Int], Formatting)]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([[Int]] -> [Formatting] -> [([Int], Formatting)])
-> ([[Int]], [Formatting]) -> [([Int], Formatting)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [[Int]] -> [Formatting] -> [([Int], Formatting)]
forall a b. [a] -> [b] -> [(a, b)]
zip
process :: [Output] -> [Output]
process xs :: [Output]
xs = ((([Int], Formatting) -> [Output])
-> [([Int], Formatting)] -> [Output])
-> [([Int], Formatting)]
-> (([Int], Formatting) -> [Output])
-> [Output]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Int], Formatting) -> [Output])
-> [([Int], Formatting)] -> [Output]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Output] -> [([Int], Formatting)]
newSuf [Output]
xs) ((([Int], Formatting) -> [Output]) -> [Output])
-> (([Int], Formatting) -> [Output]) -> [Output]
forall a b. (a -> b) -> a -> b
$
\(x :: [Int]
x,f :: Formatting
f) -> if [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 2
then Output -> [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> [Output]) -> Output -> [Output]
forall a b. (a -> b) -> a -> b
$ [Output] -> Formatting -> Output
Output [ String -> Formatting -> Output
OStr [Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. [a] -> a
head [Int]
x] Formatting
f
, [Inline] -> Output
OPan [Text -> Inline
Str "\x2013"]
, String -> Formatting -> Output
OStr [Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. [a] -> a
last [Int]
x] Formatting
f
] Formatting
emptyFormatting
else (Int -> Output) -> [Int] -> [Output]
forall a b. (a -> b) -> [a] -> [b]
map (\y :: Int
y -> if Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Output
ONull else (String -> Formatting -> Output) -> Formatting -> String -> Output
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Formatting -> Output
OStr Formatting
f (String -> Output) -> (Int -> String) -> Int -> Output
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr (Int -> Output) -> Int -> Output
forall a b. (a -> b) -> a -> b
$ Int
y) [Int]
x
addCiteAffixes :: Cite -> Output -> Output
addCiteAffixes :: Cite -> Output -> Output
addCiteAffixes c :: Cite
c x :: Output
x =
if [Output] -> Bool
isNumStyle [Output
x]
then Output
x
else [Output] -> Formatting -> Output
Output ( Bool -> Formatted -> [Output]
addCiteAff Bool
True (Cite -> Formatted
citePrefix Cite
c) [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ [Output
x] [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++
Bool -> Formatted -> [Output]
addCiteAff Bool
False (Cite -> Formatted
citeSuffix Cite
c)) Formatting
emptyFormatting
where
addCiteAff :: Bool -> Formatted -> [Output]
addCiteAff isprefix :: Bool
isprefix y :: Formatted
y =
case Formatted
y of
Formatted [] -> []
Formatted ils :: [Inline]
ils
| Bool
isprefix -> case [Inline] -> [Inline]
forall a. [a] -> [a]
reverse [Inline]
ils of
(Str zs :: Text
zs@(Text -> Maybe (Char, Text)
T.uncons -> Just (_,_)):_) |
Text -> Char
T.last Text
zs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\160' -> [[Inline] -> Output
OPan [Inline]
ils]
_ -> [[Inline] -> Output
OPan [Inline]
ils, Output
OSpace]
| Bool
otherwise -> case [Inline]
ils of
(Str (Text -> Maybe (Char, Text)
T.uncons -> Just (z :: Char
z,_)):_)
| Char -> Bool
isAlphaNum Char
z Bool -> Bool -> Bool
||
Char
z Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '(' -> [Output
OSpace, [Inline] -> Output
OPan [Inline]
ils]
_ -> [[Inline] -> Output
OPan [Inline]
ils]
isNumStyle :: [Output] -> Bool
isNumStyle :: [Output] -> Bool
isNumStyle = Any -> Bool
getAny (Any -> Bool) -> ([Output] -> Any) -> [Output] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output -> Any) -> [Output] -> Any
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> Any
ocitnum
where
ocitnum :: Output -> Any
ocitnum OCitNum {} = Bool -> Any
Any Bool
True
ocitnum _ = Bool -> Any
Any Bool
False
groupConsec :: [Int] -> [[Int]]
groupConsec :: [Int] -> [[Int]]
groupConsec = (Int -> Int) -> [Int] -> [[Int]]
forall a. (a -> Int) -> [a] -> [[a]]
groupConsecWith Int -> Int
forall a. a -> a
id
groupConsecWith :: (a -> Int) -> [a] -> [[a]]
groupConsecWith :: (a -> Int) -> [a] -> [[a]]
groupConsecWith f :: a -> Int
f = (a -> [[a]] -> [[a]]) -> [[a]] -> [a] -> [[a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> [[a]] -> [[a]]
go [] ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((a -> Int) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> Int
f)
where go :: a -> [[a]] -> [[a]]
go x :: a
x [] = [[a
x]]
go x :: a
x ((y :: a
y:ys :: [a]
ys):gs :: [[a]]
gs) = if (a -> Int
f a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Int
f a
y
then (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
gs
else [a
x][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:(a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
gs
go _ ([]:_) = String -> [[a]]
forall a. HasCallStack => String -> a
error "groupConsec: head of list is empty"