{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards     #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.CSL.Proc.Collapse
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Andrea Rossato <andrea.rossato@unitn.it>
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module provides functions for processing the evaluated
-- 'Output' for citation collapsing.
--
-----------------------------------------------------------------------------

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           Data.Text              (Text)
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          (proc, proc', query)
import           Text.Pandoc.Definition (Inline (Str))

-- | Collapse citations according to the style options.
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 -> [Text]
getCollapseOptions Style
s of
                     "year"               : _ -> Style -> Text -> CitationGroup -> CitationGroup
collapseYear Style
s ""
                     "year-suffix"        : _ -> Style -> Text -> CitationGroup -> CitationGroup
collapseYear Style
s "year-suffix"
                     "year-suffix-ranged" : _ -> Style -> Text -> CitationGroup -> CitationGroup
collapseYear Style
s "year-suffix-ranged"
                     "citation-number"    : _ -> CitationGroup -> CitationGroup
collapseNumber
                     _                        -> CitationGroup -> CitationGroup
forall a. a -> a
id

-- | Get the collapse option set in the 'Style' for citations.
getCollapseOptions :: Style -> [Text]
getCollapseOptions :: Style -> [Text]
getCollapseOptions
    = ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd ([(Text, Text)] -> [Text])
-> (Style -> [(Text, Text)]) -> Style -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) "collapse" (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) ([(Text, Text)] -> [(Text, Text)])
-> (Style -> [(Text, Text)]) -> Style -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [(Text, Text)]
citOptions (Citation -> [(Text, Text)])
-> (Style -> Citation) -> Style -> [(Text, Text)]
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 :: Text
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 -> Text -> [(Cite, Output)] -> CitationGroup
CG [] Formatting
f Text
d [(Cite, Output)]
os
-- note:  for numerical styles, we treat author-in-text citations just
-- like any others.
    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 -> Text -> CitationGroup -> CitationGroup
collapseYear :: Style -> Text -> CitationGroup -> CitationGroup
collapseYear s :: Style
s ranged :: Text
ranged (CG cs :: [(Cite, Output)]
cs f :: Formatting
f d :: Text
d os :: [(Cite, Output)]
os) = [(Cite, Output)]
-> Formatting -> Text -> [(Cite, Output)] -> CitationGroup
CG [(Cite, Output)]
cs Formatting
f "" ([(Cite, Output)] -> [(Cite, Output)]
process [(Cite, Output)]
os)
    where
      styleYSD :: Text
styleYSD    = Text -> [(Text, Text)] -> Text
getOptionVal "year-suffix-delimiter"    ([(Text, Text)] -> Text)
-> (Style -> [(Text, Text)]) -> Style -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [(Text, Text)]
citOptions (Citation -> [(Text, Text)])
-> (Style -> Citation) -> Style -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Citation
citation (Style -> Text) -> Style -> Text
forall a b. (a -> b) -> a -> b
$ Style
s
      yearSufDel :: Text
yearSufDel  = if Text -> Bool
T.null Text
styleYSD
                    then Layout -> Text
layDelim (Layout -> Text) -> (Style -> Layout) -> Style -> Text
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 -> Text) -> Style -> Text
forall a b. (a -> b) -> a -> b
$ Style
s
                    else Text
styleYSD
      afterCD :: Text
afterCD     = Text -> [(Text, Text)] -> Text
getOptionVal "after-collapse-delimiter" ([(Text, Text)] -> Text)
-> (Style -> [(Text, Text)]) -> Style -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [(Text, Text)]
citOptions (Citation -> [(Text, Text)])
-> (Style -> Citation) -> Style -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Citation
citation (Style -> Text) -> Style -> Text
forall a b. (a -> b) -> a -> b
$ Style
s
      afterColDel :: Text
afterColDel = if Text -> Bool
T.null Text
afterCD then Text
d else Text
afterCD

      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 Text
ranged of
                   "year-suffix-ranged" -> Bool
True
                   _                    -> Bool
False

      collapseRange :: [(Cite, Output)] -> [Output]
collapseRange = if Text -> Bool
T.null Text
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 -> Text -> [(Cite, Output)] -> [Output]
collapseYearSuf Bool
isRanged Text
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 :: Text
delim = let d' :: Text
d' = Text -> [(Text, Text)] -> Text
getOptionVal "cite-group-delimiter" ([(Text, Text)] -> Text)
-> (Style -> [(Text, Text)]) -> Style -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [(Text, Text)]
citOptions (Citation -> [(Text, Text)])
-> (Style -> Citation) -> Style -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Citation
citation (Style -> Text) -> Style -> Text
forall a b. (a -> b) -> a -> b
$ Style
s
              -- FIXME: see https://bitbucket.org/bdarcus/citeproc-test/issue/15
              -- in  if null d' then if null d then ", " else d else d'
              in  if Text -> Bool
T.null Text
d' then ", " else Text
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
.
                             Text -> [Output] -> [Output]
addDelim Text
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]
: [Text -> Output
ODel Text
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]
: [Text -> Output
ODel Text
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 -> Text -> [(Cite,Output)] -> [Output]
collapseYearSuf :: Bool -> Text -> [(Cite, Output)] -> [Output]
collapseYearSuf ranged :: Bool
ranged ysd :: Text
ysd = [(Cite, Output)] -> [Output]
process
    where
      yearOf :: Output -> Text
yearOf  = [Text] -> Text
T.concat ([Text] -> Text) -> (Output -> [Text]) -> Output -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output -> [Text]) -> Output -> [Text]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [Text]
getYear
      getYear :: Output -> [Text]
getYear o :: Output
o
          | OYear y :: Text
y _ _ <- Output
o = [Text
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 -> Text
yearOf ((Cite, Output) -> Output
forall a b. (a, b) -> b
snd (Cite, Output)
a) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Output -> Text
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
&&
                 Text -> Bool
T.null (Cite -> Text
citeLocator (Cite -> Text) -> Cite -> Text
forall a b. (a -> b) -> a -> b
$ (Cite, Output) -> Cite
forall a b. (a, b) -> a
fst (Cite, Output)
a) Bool -> Bool -> Bool
&&
                 Text -> Bool
T.null (Cite -> Text
citeLocator (Cite -> Text) -> Cite -> Text
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]
: Text -> [Output] -> [Output]
addDelim Text
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 Text -> [Output] -> [Output]
addDelim Text
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 :: Text
s _ _ f :: Formatting
f <- Output
o = [(if Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "" then Char -> Int
ord (Text -> Char
T.head Text
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 [ Text -> Formatting -> Output
OStr (Char -> Text
T.singleton (Char -> Text) -> (Int -> Char) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr (Int -> Text) -> Int -> Text
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"]
                                                  , Text -> Formatting -> Output
OStr (Char -> Text
T.singleton (Char -> Text) -> (Int -> Char) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr (Int -> Text) -> Int -> Text
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 (Text -> Formatting -> Output) -> Formatting -> Text -> Output
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Formatting -> Output
OStr Formatting
f (Text -> Output) -> (Int -> Text) -> Int -> Output
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Text) -> (Int -> Char) -> Int -> Text
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

-- | Group consecutive integers:
--
-- > groupConsec [1,2,3,5,6,8,9] == [[1,2,3],[5,6],[8,9]]
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 _ ([]:_) = [Char] -> [[a]]
forall a. HasCallStack => [Char] -> a
error "groupConsec: head of list is empty"