{-# 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.Char
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 s []
                     "year-suffix"        : _ -> collapseYear s "year-suffix"
                     "year-suffix-ranged" : _ -> collapseYear s "year-suffix-ranged"
                     "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 = mapCitationGroup process
    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 :: Style -> String -> CitationGroup -> CitationGroup
collapseYear s ranged (CG cs f d os) = CG cs f [] [(emptyCite, process $ map snd os)]
    where
      styleYSD    = getOptionVal "year-suffix-delimiter"    . citOptions . citation $ s
      yearSufDel  = styleYSD `betterThen` (layDelim . citLayout . citation $ s)
      afterCD     = getOptionVal "after-collapse-delimiter" . citOptions . citation $ s
      afterColDel = afterCD  `betterThen` d

      format []     = []
      format (x:xs) = x : map getYearAndSuf xs
      getYearAndSuf x = case  query getOYear x of
                          [] -> noOutputError
                          x' -> Output x' emptyFormatting
      getOYear o
          | OYear    {} <- o = [o]
          | OYearSuf {} <- o = [o]
          | OPan     {} <- o = [o]
          | otherwise        = []

      isRanged = case ranged of
                   "year-suffix-ranged" -> True
                   _                    -> False
      collapsYS xs = if length xs < 2 || null ranged
                     then xs
                     else collapseYearSuf isRanged yearSufDel xs
      addDelimiter []     = []
      addDelimiter (x:[]) = [addDelim d x]
      addDelimiter (x:xs) = if length x > 1
                            then (addDelim d x ++ [ODel afterColDel]) : addDelimiter xs
                            else (addDelim d x ++ [ODel d          ]) : addDelimiter xs
      namesOf = map (fst . snd) . getNamesYear True
      process = flip Output emptyFormatting . concat . addDelimiter .
                map (collapsYS . format) . groupBy (\a b -> namesOf a == namesOf b)

collapseYearSuf :: Bool -> String -> [Output] -> [Output]
collapseYearSuf ranged ysd = process
    where
      yearOf  = concat . query getYear
      getYear o
          | OYear y _ _ <- o = [y]
          | otherwise        = []

      processYS = if ranged then collapseYearSufRanged else id
      process = map (flip Output emptyFormatting . getYS) .
                groupBy (\a b -> yearOf a == yearOf b)

      getYS []     = []
      getYS (x:xs) = if ranged
                     then proc rmOYearSuf x : addDelim ysd (processYS $ x : query rmOYear xs)
                     else addDelim ysd  $ x : (processYS $ query rmOYear xs)
      rmOYearSuf o
          | OYearSuf {} <- o = ONull
          | otherwise        = o
      rmOYear o
          | OYearSuf {} <- o = [o]
          | otherwise        = []

collapseYearSufRanged :: [Output] -> [Output]
collapseYearSufRanged = process
    where
      getOYS o
          | OYearSuf s _ _ f <- o = [(if s /= [] then ord (head s) else 0, f)]
          | otherwise             = []
      sufOf   = foldr (\x _ -> x) (0,emptyFormatting) . query getOYS
      newSuf  = map sufOf >>> (map fst >>> groupConsec) &&& map snd >>> uncurry zip
      process xs = flip concatMap (newSuf xs) $
                   \(x,f) -> if length x > 2
                             then return $ Output [ OStr [chr $ head x] f
                                                  , ODel "-"
                                                  , OStr [chr $ last x] f
                                                  ] emptyFormatting
                             else map (\y -> if y == 0 then ONull else flip OStr f . return . chr $ y) x

-- | 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