-- | Converts Pandoc to reStructuredText.
module Text.Pandoc.Writers.RST (
                                writeRST 
                               ) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import List ( nubBy )
import Text.PrettyPrint.HughesPJ hiding ( Str )

-- | Convert Pandoc to reStructuredText.
writeRST :: WriterOptions -> Pandoc -> String
writeRST options (Pandoc meta blocks) = 
    let (main, refs) = unzip $ map (blockToRST (writerTabStop options)) 
                       (reformatBlocks $ replaceReferenceLinks blocks) 
        top = if (writerStandalone options) then 
                  (metaToRST meta) $$ text (writerHeader options) 
              else 
                  empty in 
    let refs' = nubBy (\x y -> (render x) == (render y)) refs in -- remove duplicate keys
    let body = text (writerIncludeBefore options) <> 
               vcat main $$ text (writerIncludeAfter options) in
    render $ top <> body $$ vcat refs'

-- | Escape special RST characters.
escapeString :: String -> String
escapeString = backslashEscape "`\\|*_" 

-- | Convert list of inline elements into one 'Doc' of wrapped text and another
-- containing references.
wrappedRST :: [Inline] -> (Doc, Doc)
wrappedRST lst = 
    let words = splitBySpace lst in
    (fsep $ map (fcat . (map (fst . inlineToRST))) words, vcat (map (snd . inlineToRST) lst))

-- | Remove reference keys, and make sure there are blanks before each list.
reformatBlocks :: [Block] -> [Block]
reformatBlocks [] = []
reformatBlocks ((Plain x):(OrderedList y):rest) = 
    (Para x):(reformatBlocks ((OrderedList y):rest))
reformatBlocks ((Plain x):(BulletList y):rest) = (Para x):(reformatBlocks ((BulletList y):rest))
reformatBlocks ((OrderedList x):rest) = 
    (OrderedList (map reformatBlocks x)):(reformatBlocks rest)
reformatBlocks ((BulletList x):rest) = (BulletList (map reformatBlocks x)):(reformatBlocks rest)
reformatBlocks ((BlockQuote x):rest) = (BlockQuote (reformatBlocks x)):(reformatBlocks rest)
reformatBlocks ((Note ref x):rest) = (Note ref (reformatBlocks x)):(reformatBlocks rest)
reformatBlocks ((Key x1 y1):rest) = reformatBlocks rest
reformatBlocks (x:rest) = x:(reformatBlocks rest)

-- | Convert bibliographic information to 'Doc'.
metaToRST :: Meta -> Doc
metaToRST (Meta title authors date) = 
    (titleToRST title) <> (authorsToRST authors) <> (dateToRST date) 

-- | Convert title to 'Doc'.
titleToRST :: [Inline] -> Doc
titleToRST [] = empty
titleToRST lst = 
    let title = fst $ inlineListToRST lst in
    let titleLength = length $ render title in
    let border = text (replicate titleLength '=') in
    border <> char '\n' <> title <> char '\n' <> border <> text "\n\n"

-- | Convert author list to 'Doc'.
authorsToRST :: [String] -> Doc
authorsToRST [] = empty
authorsToRST (first:rest) = text ":Author: " <> text first <> char '\n' <> (authorsToRST rest)

-- | Convert date to 'Doc'.
dateToRST :: String -> Doc
dateToRST [] = empty
dateToRST str = text ":Date: " <> text (escapeString str) <> char '\n'

-- | Convert Pandoc block element to a 'Doc' containing the main text and 
-- another one containing any references.
blockToRST :: Int        -- ^ tab stop
           -> Block      -- ^ block element to convert
           -> (Doc, Doc) -- ^ first element is text, second is references for end of file
blockToRST tabStop Blank = (text "\n", empty)
blockToRST tabStop Null = (empty, empty)
blockToRST tabStop (Plain lst) = wrappedRST lst
blockToRST tabStop (Para [TeX str]) =    -- raw latex block
    let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in
    (hang (text "\n.. raw:: latex\n") 3 (vcat $ map text (lines str')), empty)
blockToRST tabStop (Para lst) = ((fst $ wrappedRST lst) <> (text "\n"), snd $ wrappedRST lst)
blockToRST tabStop (BlockQuote lst) = 
    let (main, refs) = unzip $ map (blockToRST tabStop) lst in
    ((nest tabStop $ vcat $ main) <> text "\n", vcat refs)
blockToRST tabStop (Note ref blocks) = 
    let (main, refs) = unzip $ map (blockToRST tabStop) blocks in
    ((hang (text ".. [" <> text (escapeString ref) <> text "] ") 3 (vcat main)), vcat refs)
blockToRST tabStop (Key txt (Src src tit)) = 
    (text "ERROR - KEY FOUND", empty) -- shouldn't have a key here
blockToRST tabStop (CodeBlock str) =  
    (hang (text "::\n") tabStop (vcat $ map text (lines ('\n':(str ++ "\n")))), empty)
blockToRST tabStop (RawHtml str) = 
    let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in
    (hang (text "\n.. raw:: html\n") 3 (vcat $ map text (lines str')), empty)
blockToRST tabStop (BulletList lst) =  
    let (main, refs) = unzip $ map (bulletListItemToRST tabStop) lst in
    (vcat main <> text "\n", vcat refs)
blockToRST tabStop (OrderedList lst) =  
    let (main, refs) = 
            unzip $ zipWith (orderedListItemToRST tabStop) (enumFromTo 1 (length lst)) lst in
    (vcat main <> text "\n", vcat refs)
blockToRST tabStop HorizontalRule = (text "--------------\n", empty)
blockToRST tabStop (Header level lst) = 
    let (headerText, refs) = inlineListToRST lst in
    let headerLength = length $ render headerText in
    let headerChar = if (level > 5) then ' ' else "=-~^'" !! (level - 1) in
    let border = text $ replicate headerLength headerChar in
    (headerText <> char '\n' <> border <> char '\n', refs)

-- | Convert bullet list item (list of blocks) to reStructuredText.
-- Returns a pair of 'Doc', the first the main text, the second references
bulletListItemToRST :: Int        -- ^ tab stop
                    -> [Block]    -- ^ list item (list of blocks)
                    -> (Doc, Doc)
bulletListItemToRST tabStop list = 
    let (main, refs) = unzip $ map (blockToRST tabStop) list in
    (hang (text "-  ") tabStop (vcat main), (vcat refs))

-- | Convert an ordered list item (list of blocks) to reStructuredText.
-- Returns a pair of 'Doc', the first the main text, the second references
orderedListItemToRST :: Int         -- ^ tab stop
                     -> Int         -- ^ ordinal number of list item
                     -> [Block]     -- ^ list item (list of blocks)
                     -> (Doc, Doc)
orderedListItemToRST tabStop num list = 
    let (main, refs) = unzip $ map (blockToRST tabStop) list 
        spacer = if (length (show num) < 2) then " " else "" in
    (hang (text ((show num) ++ "." ++ spacer)) tabStop (vcat main), (vcat refs))

-- | Convert a list of inline elements to reStructuredText.
-- Returns a pair of 'Doc', the first the main text, the second references.
inlineListToRST :: [Inline] -> (Doc, Doc)
inlineListToRST lst = let (main, refs) = unzip $ map inlineToRST lst in
                      (hcat main, hcat refs)

-- | Convert an inline element to reStructuredText.
-- Returns a pair of 'Doc', the first the main text, the second references.
inlineToRST :: Inline -> (Doc, Doc) -- second Doc is list of refs for end of file
inlineToRST (Emph lst) = let (main, refs) = inlineListToRST lst in
                         (text "*" <> main <> text "*", refs)
inlineToRST (Strong lst) = let (main, refs) = inlineListToRST lst in
                         (text "**" <> main <> text "**", refs)
inlineToRST (Code str) = (text $ "``" ++ str ++ "``", empty)
inlineToRST (Str str) = (text $ escapeString str, empty)
inlineToRST (TeX str) = (text str, empty)
inlineToRST (HtmlInline str) = (empty, empty)
inlineToRST (LineBreak) = inlineToRST Space -- RST doesn't have line breaks
inlineToRST Space = (char ' ', empty)
--
-- Note:  can assume reference links have been replaced where possible with explicit links.
--
inlineToRST (Link txt (Src src tit)) = 
    let (linktext, ref') = if (null txt) || (txt == [Str ""]) then 
                               (text "link", empty)
                           else 
                               inlineListToRST $ normalizeSpaces txt in
    let link = char '`' <> linktext <> text "`_" 
        linktext' = render linktext in
    let linktext'' = if (':' `elem` linktext') then "`" ++ linktext' ++ "`" else linktext' in
    let ref = text ".. _" <> text linktext'' <> text ": " <> text src  in
    (link, ref' $$ ref)
inlineToRST (Link txt (Ref [])) = 
    let (linktext, refs) = inlineListToRST txt in
    (char '[' <> linktext <> char ']', refs)   
inlineToRST (Link txt (Ref ref)) = 
    let (linktext, refs1) = inlineListToRST txt 
        (reftext, refs2) = inlineListToRST ref in
    (char '[' <> linktext <> text "][" <> reftext <> char ']', refs1 $$ refs2)
inlineToRST (Image alternate (Src source tit)) = 
     let (alt, ref') = if (null alternate) || (alternate == [Str ""]) then 
                           (text "image", empty) 
                       else 
                           inlineListToRST $ normalizeSpaces alternate in
     let link = char '|' <> alt <> char '|' in
     let ref = text ".. " <> link <> text " image:: " <> text source  in
     (link, ref' $$ ref)
inlineToRST (Image alternate (Ref [])) = 
    let (alttext, refs) = inlineListToRST alternate in
    (char '|' <> alttext <> char '|', refs)
-- The following case won't normally occur...
inlineToRST (Image alternate (Ref ref)) = 
    let (alttext, refs1) = inlineListToRST alternate
        (reftext, refs2) = inlineListToRST ref in
    (char '|' <> alttext <> char '|', refs1 $$ refs2)
inlineToRST (NoteRef ref) = (text " [" <> text (escapeString ref) <> char ']' <> char '_', empty)