{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.CSL.Eval.Output
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Andrea Rossato <andrea.rossato@unitn.it>
-- Stability   :  unstable
-- Portability :  unportable
--
-- The CSL implementation
--
-----------------------------------------------------------------------------

module Text.CSL.Eval.Output where

import Prelude
import           Data.Maybe             (mapMaybe)
import           Data.String            (fromString)
import           Data.Text              (Text)
import qualified Data.Text              as T
import           Text.CSL.Output.Pandoc (lastInline)
import           Text.CSL.Style
import           Text.CSL.Util          (capitalize, isPunct, titlecase,
                                         unTitlecase)
import           Text.Pandoc.Definition
import           Text.Pandoc.Walk       (walk)
import           Text.Parsec
import           Text.Parsec.Text       (Parser)

-- Parse affix or delimiter into Formatted, splitting out
-- raw components in @{{format}}...{{/format}}@.
formatString :: Text -> Formatted
formatString s =
  case parse pAffix (T.unpack s) s of
       Left _    -> fromString (T.unpack s)
       Right ils -> Formatted ils

pAffix :: Parser [Inline]
pAffix = many (pRaw <|> pString <|> pSpace)

pRaw :: Parser Inline
pRaw = try $ do
  _ <- string "{{"
  format <- many1 letter
  _ <- string "}}"
  contents <- manyTill anyChar (try (string ("{{/" ++ format ++ "}}")))
  return $ RawInline (Format $ T.pack format) $ T.pack contents

pString :: Parser Inline
pString = Str . T.pack <$> (many1 (noneOf " \t\n\r{}") <|> count 1 (oneOf "{}"))

pSpace :: Parser Inline
pSpace = Space <$ many1 (oneOf " \t\n\r")

output :: Formatting -> Text -> [Output]
output fm s = case T.uncons s of
  Nothing        -> []
  Just (' ', xs) -> OSpace : output fm xs
  _              -> [OStr s fm]

appendOutput :: Formatting -> [Output] -> [Output]
appendOutput fm xs = [Output xs fm | xs /= []]

outputList :: Formatting -> Delimiter -> [Output] -> [Output]
outputList fm d = appendOutput fm . addDelim d . mapMaybe cleanOutput'
    where
      cleanOutput' o
          | Output xs f <- o = case cleanOutput xs of
                                 [] -> Nothing
                                 ys -> Just (Output ys f)
          | otherwise        = rmEmptyOutput o

cleanOutput :: [Output] -> [Output]
cleanOutput = flatten
    where
      flatten [] = []
      flatten (o:os)
          | ONull       <- o     = flatten os
          | Output xs f <- o
          , f == emptyFormatting = flatten (mapMaybe rmEmptyOutput xs) ++ flatten os
          | Output xs f <- o     = Output (flatten $ mapMaybe rmEmptyOutput xs) f : flatten os
          | otherwise            = maybe id (:) (rmEmptyOutput o) $ flatten os

rmEmptyOutput :: Output -> Maybe Output
rmEmptyOutput o
    | Output [] _ <- o = Nothing
    | OStr ""   _ <- o = Nothing
    | OPan []     <- o = Nothing
    | OStatus []  <- o = Nothing
    | ODel ""     <- o = Nothing
    | otherwise        = Just o

addDelim :: Text -> [Output] -> [Output]
addDelim "" = id
addDelim d  = foldr check []
    where
      check ONull xs   = xs
      check x     []   = [x]
      check x (z:zs)   = if formatOutput x == mempty || formatOutput z == mempty
                            then x : z : zs
                            else x : ODel d : z : zs

noOutputError :: Output
noOutputError = OErr NoOutput

noBibDataError :: Cite -> Output
noBibDataError c = OErr $ ReferenceNotFound (citeId c)

oStr :: Text -> [Output]
oStr s = oStr' s emptyFormatting

oStr' :: Text -> Formatting -> [Output]
oStr' "" _ = []
oStr' s  f = [OStr s f]

oPan :: [Inline] -> [Output]
oPan []  = []
oPan ils = [OPan ils]

oPan' :: [Inline] -> Formatting -> [Output]
oPan' [] _  = []
oPan' ils f = [Output [OPan ils] f]

formatOutputList :: [Output] -> Formatted
formatOutputList = mconcat . map formatOutput

-- | Convert evaluated 'Output' into 'Formatted', ready for the
-- output filters.
formatOutput :: Output -> Formatted
formatOutput o =
  case o of
      OSpace              -> Formatted [Space]
      OPan     i          -> Formatted i
      OStatus  i          -> Formatted i
      ODel     ""         -> Formatted []
      ODel     " "        -> Formatted [Space]
      ODel     "\n"       -> Formatted [SoftBreak]
      ODel     s          -> formatString s
      OStr     ""      _  -> Formatted []
      OStr     s       f  -> addFormatting f $ formatString s
      OErr NoOutput       -> Formatted [Span ("",["citeproc-no-output"],[])
                                     [Strong [Str "???"]]]
      OErr (ReferenceNotFound r)
                          -> Formatted [Span ("",["citeproc-not-found"],
                                            [("data-reference-id",r)])
                                     [Strong [Str "???"]]]
      OLabel   ""      _  -> Formatted []
      OLabel   s       f  -> addFormatting f $ formatString s
      ODate    os         -> formatOutputList os
      OYear    s _     f  -> addFormatting f $ formatString s
      OYearSuf s _ _   f  -> addFormatting f $ formatString s
      ONum     i       f  -> formatOutput (OStr (T.pack (show i)) f)
      OCitNum  i       f  -> if i == 0
                                then Formatted [Strong [Str "???"]]
                                else formatOutput (OStr (T.pack $ show i) f)
      OCitLabel s      f  -> if s == ""
                                then Formatted [Strong [Str "???"]]
                                else formatOutput (OStr s f)
      OName  _ os _    f  -> formatOutput (Output os f)
      OContrib _ _ os _ _ -> formatOutputList os
      OLoc     os      f  -> formatOutput (Output os f)
      Output   []      _  -> Formatted []
      Output   os      f  -> addFormatting f $ formatOutputList os
      _                   -> Formatted []

addFormatting :: Formatting -> Formatted -> Formatted
addFormatting f =
  addDisplay . addLink . addSuffix . pref . quote . font . text_case . strip_periods
  where addLink i = case hyperlink f of
                         ""  -> i
                         url -> Formatted [Link nullAttr (unFormatted i) (url, "")]
        pref i = case prefix f of
                      "" -> i
                      x  -> formatString x <> i
        addSuffix i
          | T.null (suffix f)       = i
          | maybe False (isPunct . fst) (T.uncons (suffix f))
          , case lastInline (unFormatted i) of {Just c | isPunct c -> True; _ -> False}
                                  = i <> formatString (T.tail $ suffix f)
          | otherwise             = i <> formatString (suffix f)

        strip_periods (Formatted ils) = Formatted (walk removePeriod ils)
        removePeriod (Str xs) | stripPeriods f = Str (T.filter (/='.') xs)
        removePeriod x        = x

        quote (Formatted [])  = Formatted []
        quote (Formatted ils) =
                    case quotes f of
                         NoQuote     -> Formatted $ valign ils
                         NativeQuote -> Formatted
                                  [Span ("",["csl-inquote"],[]) ils]
                         _           -> Formatted [Quoted DoubleQuote $ valign ils]

        addDisplay (Formatted []) = Formatted []
        addDisplay (Formatted ils) =
                     case display f of
                          "block"    -> Formatted (LineBreak : ils ++
                                                       [LineBreak])
                          _          -> Formatted ils

        font (Formatted ils)
          | noDecor f    = Formatted [Span ("",["nodecor"],[]) ils]
          | otherwise    = Formatted $ font_variant . font_style .  font_weight $ ils
        font_variant ils =
          case fontVariant f of
               "small-caps" -> [SmallCaps ils]
               _            -> ils
        font_style ils =
          case fontStyle f of
               "italic"  -> [Emph ils]
               "oblique" -> [Emph ils]
               _         -> ils
        font_weight ils =
          case fontWeight f of
               "bold" -> [Strong ils]
               _      -> ils

        text_case (Formatted []) = Formatted []
        text_case (Formatted ils@(i:is'))
          | noCase f  = Formatted [Span ("",["nocase"],[]) ils]
          | otherwise = Formatted $
              case textCase f of
                   "lowercase"        -> walk lowercaseStr ils
                   "uppercase"        -> walk uppercaseStr ils
                   "capitalize-all"   -> walk capitalizeStr ils
                   "title"            -> titlecase ils
                   "capitalize-first"
                     -> case i of
                             Str cs -> Str (capitalize cs) : is'
                             _ -> unTitlecase [i] ++ is'
                   "sentence"         -> unTitlecase ils
                   _                  -> ils

        lowercaseStr (Str xs) = Str $ T.toLower xs
        lowercaseStr x        = x
        uppercaseStr (Str xs) = Str $ T.toUpper xs
        uppercaseStr x        = x
        capitalizeStr (Str xs) = Str $ capitalize xs
        capitalizeStr x        = x

        valign [] = []
        valign ils
          | "sup"      <- verticalAlign f = [Superscript ils]
          | "sub"      <- verticalAlign f = [Subscript   ils]
          | "baseline" <- verticalAlign f =
                              [Span ("",["csl-baseline"],[]) ils]
          | otherwise                     = ils