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

module Text.CSL.Output.Pandoc
    ( renderPandoc
    , renderPandocStrict
    , renderPandoc'
    , Pandoc (..), Meta (..)
    ) where

import Data.Char ( toUpper, toLower )
import Data.List

import Text.CSL.Style
import Text.CSL.Output.Plain

-- | With a 'Style' and the formatted output generate a 'String' in
-- the native 'Pandoc' formats (i.e. immediately readable by pandoc).
renderPandoc :: Style -> [FormattedOutput] -> String
renderPandoc _
    = show . clean . concatMap (render False)

-- | Same as 'renderPandoc', but the output is wrapped in a pandoc
-- paragraph block.
renderPandoc' :: Style -> [FormattedOutput] -> String
renderPandoc' _
    = show . Para . clean . concatMap (render False)

-- | Same as 'renderPandoc', but will not clean up the produced
-- output.
renderPandocStrict :: [FormattedOutput] -> String
renderPandocStrict
    = show . cleanStrict . concatMap (render True)

render :: Bool -> FormattedOutput -> [Inline]
render _ (Delimiter   s) = toStr s
render b (FO  str fm xs) = toStr (prefix fm) ++
                           quote (formatted ++ rest) ++
                           toStr (suffix fm)
    where
      formatted = font_variant . font . text_case . trim $ str
      rest      = procList xs $ concatMap (render b)
      trim      = if b then id          else unwords . words
      cleaner   = if b then cleanStrict else clean

      quote   i = if i /= [] && quotes fm
                  then [Quoted DoubleQuote . valign . cleaner $ i]
                  else valign (cleaner i)

      capital s = toUpper (head s) : (tail s)

      text_case s
          | "capitalize-first" <- textCase fm = procList s capital
          | "capitalize-all"   <- textCase fm = procList s $ unwords . map capital . words
          | "lowercase"        <- textCase fm = map toLower s
          | "uppercase"        <- textCase fm = map toUpper s
          | otherwise                         = s

      font_variant i
          | "small-caps" <- fontVariant fm = [SmallCaps i]
          | otherwise                      = i

      font
          | "italic"  <- fontStyle  fm = return . Emph   . toStr
          | "oblique" <- fontStyle  fm = return . Emph   . toStr
          | "normal"  <- fontStyle  fm
          , "bold"    <- fontWeight fm = return . Strong . toStr
          | otherwise                  =                   toStr

      valign i
          |  "sup"  <- verticalAlign fm = [Superscript i]
          |  "sub"  <- verticalAlign fm = [Subscript   i]
          | otherwise                   =              i

toStr :: String -> [Inline]
toStr s
    | ' ':xs <- s = Space : toStr xs
    |  x :xs <- s = cleanStrict $ Str [x] : toStr xs
    | otherwise   = []

cleanStrict :: [Inline] -> [Inline]
cleanStrict    []  = []
cleanStrict (i:is)
    | Str []  <- i      =         cleanStrict is
    | Str " " <- i      = Space : cleanStrict is
    | Str sa  <- i, is /= []
    , Str sb <- head is = Str (sa ++ sb) : cleanStrict (tail is)
    | otherwise         =              i : cleanStrict is

clean :: [Inline] -> [Inline]
clean    []  = []
clean (i:is) = if lastInline [i] == headInline is && isPunct
               then i : clean (tailInline is)
               else i : clean is
    where isPunct = and . map (flip elem ";,:. ") $ headInline is

headInline :: [Inline] -> String
headInline [] = []
headInline (i:_)
    | Str s <- i = head' s
    | Space <- i = " "
    | otherwise  = headInline $ getInline i
    where
      head' s = if s /= [] then [head s] else []

lastInline :: [Inline] -> String
lastInline [] = []
lastInline (i:[])
    | Str s <- i = last' s
    | Space <- i = " "
    | otherwise  = lastInline $ getInline i
    where
      last' s = if s /= [] then [last s] else []
lastInline (_:xs) = lastInline xs

tailInline :: [Inline] -> [Inline]
tailInline [] = []
tailInline (i:xs)
    | Str          s <- i = cleanStrict $ Str         (tail'       s) : xs
    | Emph        is <- i = cleanStrict $ Emph        (tailInline is) : xs
    | SmallCaps   is <- i = cleanStrict $ SmallCaps   (tailInline is) : xs
    | Strong      is <- i = cleanStrict $ Strong      (tailInline is) : xs
    | Superscript is <- i = cleanStrict $ Superscript (tailInline is) : xs
    | Subscript   is <- i = cleanStrict $ Subscript   (tailInline is) : xs
    | Quoted q    is <- i = cleanStrict $ Quoted q    (tailInline is) : xs
    | Space          <- i = cleanStrict $ xs
    | otherwise           = []
    where
      tail' s = if s /= [] then tail s else []

getInline :: Inline -> [Inline]
getInline i
    | Emph        is <- i = is
    | SmallCaps   is <- i = is
    | Strong      is <- i = is
    | Superscript is <- i = is
    | Subscript   is <- i = is
    | Quoted _    is <- i = is
    | otherwise           = []

data Pandoc
    = Pandoc Meta [Block]
      deriving (Eq, Read, Show)

data Meta
    = Meta [Inline] [String] String
      deriving (Eq, Show, Read)

data Block
    = Para  [Inline]
    deriving (Show, Eq, Read)

data Inline
    = Str               String  -- ^ Text (string)
    | Emph             [Inline] -- ^ Emphasized text (list of inlines)
    | SmallCaps        [Inline] -- ^ Small caps text (list of inlines)
    | Strong           [Inline] -- ^ Strongly emphasized text (list of inlines)
    | Superscript      [Inline] -- ^ Superscripted text (list of inlines)
    | Subscript        [Inline] -- ^ Subscripted text (list of inlines)
    | Space                     -- ^ Inter-word space
    | Quoted QuoteType [Inline] -- ^ Quoted text (list of inlines)
    deriving (Show, Eq, Read)

-- | Type of quotation marks to use in Quoted inline.
data QuoteType = DoubleQuote deriving (Show, Eq, Read)