-- Copyright (C) 2009-2013 Emil Axelsson <emax@chalmers.se>
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

-- |
-- Copyright  : Copyright (C) 2009-2012 Emil Axelsson <emax@chalmers.se>
-- License    : GNU GPL, version 2 or above
--
-- Maintainer : Emil Axelsson <emax@chalmers.se>
--
-- Conversion of shelf documents to HTML.

module Generate where



import Control.Monad
import qualified Data.Foldable as Fold
import Data.Function
import Data.List
import System.FilePath

import Text.CSL.Pandoc (processCites)
import Text.Pandoc
import Text.Pandoc.Error

import Types



-- | Checks wether a path starts with @http:\/\/@.
isHttp :: FilePath -> Bool
isHttp path = ("http://" `isPrefixOf` path) || ("https://" `isPrefixOf` path)

-- | Drops the @file:\/\/@ prefix (if any) of a path.
dropFile :: FilePath -> FilePath
dropFile path = case stripPrefix "file://" path of
    Just path' -> path'
    Nothing    -> path

-- | Drops the label (if any) from a path. For example
--
-- > dropLabel "/dir/file.html#label" == "/dir/file.html"
-- > dropLabel "/dir/file.html"       == "/dir/file.html"
dropLabel :: FilePath -> FilePath
dropLabel = takeWhile (/='#')

-- | Applies the function to the path without its label (if any) (see
-- `dropLabel`), and adds the label back to the result again.
underLabel :: (FilePath -> FilePath) -> (FilePath -> FilePath)
underLabel f pathLab = f path ++ label
  where
    (path,label) = break (=='#') pathLab

-- | Redirects a link to a @.shelf@ file, by changing the @.shelf@ extension to
-- @.shelf.html@. Links to non-shelf files are passed through unchanged.
redirect :: FilePath -> FilePath
redirect path = underLabel redir path
  where
    redir path
        | takeExtension path == ".shelf" = path ++ ".html"
        | otherwise                      = path

-- | Lifts `redirect` to Pandoc inline elements (links).
redirectLink :: Inline -> Inline
redirectLink (Link is (path,tit)) = Link is (redirect path, tit)
redirectLink i                    = i

-- | Collects local links (at most one) from a Pandoc inline element.
localLink :: Inline -> [FilePath]
localLink inl = case inl of
    Link  _ (path,_) -> linked path
    Image _ (path,_) -> linked path
    _                -> []
  where
    linked path = do
      guard (not $ isHttp path)
      return (dropLabel $ dropFile path)

-- | Assumes that the input string is plain text, without any markdown syntax.
pandocStr :: String -> [Inline]
pandocStr = intersperse Space . map Str . words

rawHtml :: String -> Block
rawHtml = RawBlock (Format "html")



-- | Displays the relative path, with each directory name linked to its index
-- file. If the `shelfDocument` field is not empty, a link to the document
-- source will be added at the end of the relative path.
makeContextPath :: ShelfInfo -> Block
makeContextPath shelfInfo = Plain
    [ Emph
         $ concat (reverse [link n dir | (n,dir) <- [0..] `zip` reverse nodes])
        ++ fileLink
    , LineBreak
    ]
  where
    nodes = splitDirectories $ relPath shelfInfo
    name  = shelfDocument shelfInfo

    link n dir =
        [ Link
            (pandocStr dir)
            (index, "Go to directory '" ++ dir ++ "'")
        , Space
        , Str "/"
        , Space
        ]
      where
        index = joinPath (replicate n "..") </> "index.html"

    fileLink = do
      guard (not $ null name)
      return $ Link (pandocStr name) (name, "View document source")



-- | Makes a link to the main document, if any. The result has 0 or 1 element.
makeMainLink :: ShelfInfo -> [Block]
makeMainLink shelfInfo = do
    Just name <- return $ mainDocument shelfInfo
    return $ Plain $ return $ Emph
      [ Str "➤"
      , Space
      , Link (pandocStr "Main document") (name, "View main document")
      ]

bookshelfCreds :: String
bookshelfCreds =
    "<div id=\"footer\">\n\
    \  Organized by <a href=\"http://www.cse.chalmers.se/~emax/bookshelf/Manual.shelf.html\">Bookshelf</a>\n\
    \</div>\n"

-- | Extracts title block information.
extractMeta :: Pandoc -> MetaInfo
extractMeta (Pandoc meta _) = MetaInfo (docTitle meta) (docAuthors meta) (docDate meta) [] []



-- | Extracts meta information about the \"main\" document from a shelf
-- document. The document body will be matched against the following form:
--
-- > Meta
-- > ====
-- >
-- >   * Title: Title of document
-- >   * Authors:
-- >       * Author number 1
-- >       * Author number 2
-- >       * etc.
-- >   * Date:    Some string indicating date
-- >   * Comment: Some comment
-- >   * Keywords:
-- >       * Keyword 1
-- >       * Keyword 2
-- >       * etc.
-- >
-- > Here comes the rest of the document.
-- > ...
-- > ...
--
-- (The header can also be a lower-level header.)
-- If the document doesn't have the above form, some or all of the returned
-- fields may be empty. However, the function does some attempt to handle
-- partial specifications. In particular, the fields are matched from the top,
-- so it's fine to leave out fields at the bottom.
parseMainMeta :: Pandoc -> MetaInfo
parseMainMeta (Pandoc _ blocks) = MetaInfo title authors date comment keywords
  where
    metaBullets = case blocks of
      Header _ _ [Str "Meta"] : BulletList bulls : _ -> bulls
      _ -> []

    bsTit : bsAuth : bsDate : bsComm : bsKeyw : _ = metaBullets ++ repeat []

    plain bs = do
      [Plain is] <- Just bs
      return is

    field f bs = Fold.concat $ do
      Str f' : rest <- plain bs
      guard (f==f')
      return rest

    parseList f bs = Fold.concat $ do
      [Plain [Str f'], BulletList bulls] <- return bs
      guard (f==f')
      mapM plain bulls

    title    = field "Title:"   bsTit
    date     = field "Date:"    bsDate
    comment  = field "Comment:" bsComm
    authors  = parseList "Authors:"  bsAuth
    keywords = parseList "Keywords:" bsKeyw



-- | Give the css option for the template that links to the supplied CSS (if any).
makeCss :: Context -> [(String, String)]
makeCss context = case cssLink context of
  Just css -> [("css", css)]
  _        -> [("css", "http://www.cse.chalmers.se/~emax/bookshelf.css")]

-- | Give the math option to supply to the HTML writer
makeMath :: Context -> HTMLMathMethod
makeMath context
    | Just l <- mathjaxLink context = if null l
        then MathJax "http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML"
        else MathJax l
    | mathml context = MathML Nothing
    | otherwise      = PlainMath



-- | @markdownToHtml shelfInfo markdown = (html,links,meta)@:
--
-- Converts a shelf document to HTML. The result also contains a list of all
-- local links in the document as well as meta information, in case such a
-- specification is given. If the document is not linked to a main document, the
-- returned meta information is taken from the title block (see Pandoc's
-- markdown syntax). If the document has a main document, the meta information
-- is obtained as specified in `parseMainMeta`.
markdownToHtml :: ShelfInfo -> String -> (String, [FilePath], MetaInfo)
markdownToHtml shelfInfo markdown = (html,links,meta)
  where
    pandoc   = handleError $ readMarkdown def{readerSmart=True} markdown
    links    = queryWith localLink pandoc
    thisMeta = extractMeta pandoc
    mainMeta = parseMainMeta pandoc

    contextBlocks
      =  [rawHtml "<div class=\"bookshelf-meta\">", makeContextPath shelfInfo]
      ++ makeMainLink shelfInfo
      ++ [rawHtml "</div>"]

    before = writeHtmlString def (Pandoc nullMeta contextBlocks)

    html
      = writeHtmlString wOpts
      $ processCites style refs
      $ bottomUp redirectLink
      $ pandoc

    meta = case mainDocument shelfInfo of
      Nothing -> thisMeta
      _       -> mainMeta

    refs       = references $ shelfContext shelfInfo
    style      = cslStyle $ shelfContext shelfInfo
    after      = bookshelfCreds
    cssInclude = makeCss $ shelfContext shelfInfo
    mathMethod = makeMath $ shelfContext shelfInfo

    wVars =
      [ ("include-after",  after)
      , ("include-before", before)
      ] ++ cssInclude

    wOpts = def
      { writerStandalone      = True
      , writerTemplate        = htmlTemplate $ shelfContext shelfInfo
      , writerVariables       = wVars
      , writerTableOfContents = True
      , writerHTMLMathMethod  = mathMethod
      , writerHighlight       = True
      }



-- | If the title is empty in the `MetaInfo`, it gets set to the supplied
-- string; otherwise nothing is changed.
fixTitle :: MetaInfo -> String -> MetaInfo
fixTitle meta tit = case title meta of
    [] -> meta {title = pandocStr tit}
    _  -> meta



-- | @listDocument file meta view info@:
--
-- Makes an item for the given document to be displayed in the directory index.
-- The link text is taken from the `title` field in @meta@. The other fields of
-- @meta@ will be put in a bullet list underneath. @file@ is the file name of
-- document. @view@ is a supplementary name of the document that will appear in
-- the link title. The @info@ argument will be inlined directly after the link.
listDocument :: String -> MetaInfo -> String -> [Inline] -> [Block]
listDocument file meta view info =
    [ Plain $ [Link (title meta) (file, "View '" ++ view ++ "'")] ++ info'
    , BulletList $ filter (not . null) $
        [ bullet $ concat $ intersperse [Str ",", Space] $ authors meta
        , bullet $ date meta
        , bullet $ comment meta
        , bullet $ concat $ intersperse [Str ",", Space] $ keywords meta
        ]
    ]
  where
    info' = do
      guard (not $ null info)
      [Space, Emph info]

    bullet is = do
      guard (not $ null is)
      [Plain [Emph is]]



-- | Makes an item for a shelf document to be displayed in the directory index
listShelfDoc :: (FilePath, MetaInfo) -> [Block]
listShelfDoc (doc,meta) = listDocument docShelfHtml meta' doc' []
  where
    doc'         = dropExtension doc
    docShelfHtml = doc `addExtension` ".html"
    meta'        = fixTitle meta doc'

-- | Makes an item for an ordinary document with meta info to be displayed in the directory index
listInfoDoc :: (FilePath, MetaInfo) -> [Block]
listInfoDoc (doc,meta) = listDocument doc meta' doc info
  where
    meta'        = fixTitle meta doc
    docShelfHtml = replaceExtension doc ".shelf" `addExtension` ".html"
    info =
      [ Str "("
      , Link
         (pandocStr "info")
         (docShelfHtml, "View document information")
      , Str ")"
      ]

-- | Makes an item for an ordinary document without meta info to be displayed in the directory index
listOrdDoc :: Monad m => String -> m Block
listOrdDoc doc = return $ Plain
  [Link (pandocStr doc) (doc, "View '" ++ doc ++ "'")]

-- | Makes an item for an sub-directory to be displayed in the directory index
listDir :: Monad m => String -> m Block
listDir dir = return $ Plain
  [ Link
      (pandocStr dir)
      (dir </> "index.html", "Go to directory '" ++ dir ++ "'")
  , LineBreak
  ]



-- | @makeIndex context shelfs infos ords dirs@:
--
-- Makes an HTML file with the index of the current directory. @shelfs@ is a
-- list of shelf documents (file name + meta information) that are not
-- associated with a main document. @infos@ is a list of ordinary documents that
-- have an associated info document. @ords@ is a list ordinary documents that
-- have no associated info document. @dirs@ is a list of all sub-directories.
makeIndex
    :: Context
    -> [(FilePath, MetaInfo)]
    -> [(FilePath, MetaInfo)]
    -> [FilePath]
    -> [FilePath]
    -> String

makeIndex context shelfs infos ords dirs = writeHtmlString wOpts pandoc
  where
    contextBlocks =
      [ rawHtml "<div class=\"bookshelf-meta\">"
      , makeContextPath (ShelfInfo context Nothing "")
      , rawHtml "</div>"
      ]

    before = writeHtmlString def (Pandoc nullMeta contextBlocks)
    after  = bookshelfCreds

    wVars =
      [ ("include-before", before)
      , ("include-after",  after)
      ] ++ makeCss context

    wOpts = def
      { writerStandalone      = True
      , writerTemplate        = htmlTemplate context
      , writerVariables       = wVars
      , writerTableOfContents = False
      , writerHTMLMathMethod  = makeMath context
      }

    shelfBlocks = map listShelfDoc $ sortBy (compare `on` fst) shelfs
    infoBlocks  = map listInfoDoc  $ sortBy (compare `on` fst) infos
    ordBlocks   = map listOrdDoc   $ sort ords

    docBlocks = do
      guard (0 < length shelfs + length infos + length ords)
      [ Header 2 nullAttr [Str "Documents"]
       , BulletList shelfBlocks
       , BulletList infoBlocks
       , BulletList ordBlocks
       ]

    dirBlocks = do
      guard (not $ null dirs)
      [Header 2 nullAttr [Str "Directories"]] ++ [BulletList $ map listDir $ sort dirs]

    pandoc = Pandoc nullMeta ([Para [LineBreak]] ++ docBlocks ++ dirBlocks)