content: {-# 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
  
  