    {-# 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)