{-# 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 Control.Arrow ( (&&&), (>>>) )
import Data.List ( groupBy )

import Text.CSL.Eval
import Text.CSL.Proc.Disamb
import Text.CSL.Style

-- | Collapse citations according to the style options.
collapseCitGroups :: Style -> [CitationGroup] -> [CitationGroup]
collapseCitGroups s
    = map doCollapse
    where
      doCollapse = case getCollapseOptions s of
                     "year"            : _ -> collapseYear
                     "year-suffix"     : _ -> collapseYearSuf
                     "citation-number" : _ -> collapseNumber
                     _                     -> id

-- | Get the collapse option set in the 'Style' for citations.
getCollapseOptions :: Style -> [String]
getCollapseOptions
    = map snd . filter ((==) "collapse" . fst) . citOptions . citation

collapseNumber :: CitationGroup -> CitationGroup
collapseNumber (CG fm d os) = CG fm d (process os)
    where
      citNum o
          | OCitNum i f <- o = [(i,f)]
          | otherwise        = []
      numOf   = foldr (\x _ -> x) (0,emptyFormatting) . query citNum
      newNum  = map numOf >>> (map fst >>> groupConsec) &&& map snd >>> uncurry zip
      process xs = flip concatMap (newNum xs) $
                   \(x,f) -> if length x > 2
                             then return $ Output [ OCitNum (head x) f
                                                  , ODel "-"
                                                  , OCitNum (last x) f
                                                  ] emptyFormatting
                             else map (flip OCitNum f) x

collapseYear :: CitationGroup -> CitationGroup
collapseYear (CG f d os) = CG f d (process os)
    where
      rmNames []     = []
      rmNames (x:xs) = x : remove xs
      remove  = proc rmFirstDelim . proc rmContribs
      namesOf = map (fst . snd) . getNamesYear
      process = map (\x -> Output (addDelim ", " $ rmNames x) emptyFormatting) .
                groupBy (\a b -> namesOf a == namesOf b)

collapseYearSuf :: CitationGroup -> CitationGroup
collapseYearSuf (CG f d os) = CG f d (process os)
    where
      rmNames []     = []
      rmNames (x:xs) = x : remove xs
      remove  = proc rmFirstDelim . proc rmYear . proc rmContribs
      namesOf = map (fst . snd) . getNamesYear
      yearOf  = concatMap (take 4 . snd . snd) . getNamesYear
      process = map (\x -> Output (addDelim ", " $ rmNames x) emptyFormatting) .
                groupBy (\a b -> namesOf a == namesOf b && yearOf a == yearOf b)

      rmYear o
          | OYear _ sf fm <- o = OYear sf sf fm
          | otherwise          = o

rmFirstDelim :: Output -> Output
rmFirstDelim o
    | Output os f <- o = Output (rm os) f
    | otherwise        = o
    where
      rm [] = []
      rm (x:xs)
          | ODel _ <- x = xs
          | otherwise   = x : rm xs

-- | Group consecutive integers:
--
-- > groupConsec [1,2,3,5,6,8,9] == [[1,2,3],[5,6],[8,9]]
groupConsec :: [Int] -> [[Int]]
groupConsec = groupConsec' []
    where
      groupConsec' x   []    = x
      groupConsec' [] (y:ys) = groupConsec' [[y]] ys
      groupConsec' xs (y:ys) = if y - head (last xs) == length (last xs)
                               then groupConsec' (init xs ++ [last xs ++ [y]]) ys
                               else groupConsec' (     xs ++ [           [y]]) ys