-- Copyright (C) 2009-2012 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.Pandoc

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



-- | 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")
      ]



-- | Makes a section with commands for editing the current document and
-- regenerating the bookshelf.
editRegenerate :: ShelfInfo -> String
editRegenerate shelfInfo = guard (showScript shelfInfo) >> script
  where
    css     = cssLink       shelfInfo
    edit    = editor        shelfInfo
    mathjax = mathjaxLink   shelfInfo
    name    = shelfDocument shelfInfo
    relPth  = relPath       shelfInfo
    rootPth = rootPath      shelfInfo

    edit' = case edit of
      Just e  -> e
      Nothing -> "editor"

    file = rootPth </> relPth </> name
    root = rootPth </> head (splitDirectories relPth)

    makeOpt (_,    Nothing)  = ""
    makeOpt (flag, Just val) = flag ++ " " ++ show val

    opts = filter (not . null) $ map makeOpt
      [ ("--editor", edit)
      , ("--css", css)
      , ("--mathjax", mathjax)
      ]

    editCmd  = edit' ++ " " ++ show file
    regenCmd = unwords ("bookshelf" : opts ++ [show root])

    script =
      "<p><br/></p>\n\
      \<div class=\"bookshelf-meta\">\n\
      \  <em>&#10148; Edit/regenerate this document:</em>\n\
      \  <pre><code>" ++ editCmd ++ "\n" ++ regenCmd ++ "</code></pre>\n\
      \</div>\n"



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 title authors date [] []
  where
    Meta title authors date = 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.
-- > ...
-- > ...
--
-- 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 1 [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' : Str ":" : rest <- plain bs
      guard (f==f')
      return rest

    parseList f bs = Fold.concat $ do
      [Plain [Str f', Str ":"], 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 a css option for the template that links to the supplied CSS (if any).
makeCss :: Context -> [(String, String)]
makeCss context = case cssLink context of
  Nothing -> []
  Just css
    -> [("css", css)]

-- | Give the math option to supply to the html writer
makeMath :: Context -> HTMLMathMethod
makeMath context = case mathjaxLink context of
  Nothing -> PlainMath
  Just l  -> MathJax l



-- | @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   = readMarkdown rOpts markdown
    links    = queryWith localLink pandoc
    thisMeta = extractMeta pandoc
    mainMeta = parseMainMeta pandoc

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

    before = writeHtmlString defaultWriterOptions (Pandoc (Meta [] [] []) contextBlocks)

    html
      = writeHtmlString wOpts
      $ bottomUp redirectLink
      $ pandoc

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

    rOpts = defaultParserState
      { stateSmart = True
      }

    after      = editRegenerate shelfInfo ++ bookshelfCreds
    cssInclude = makeCss $ shelfContext shelfInfo
    mathMethod = makeMath $ shelfContext shelfInfo

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

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



-- | 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]]



-- | @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 =
      [ RawBlock "html" "<div class=\"bookshelf-meta\">"
      , makeContextPath (ShelfInfo context Nothing "")
      , RawBlock "html" "</div>"
      ]

    before = writeHtmlString defaultWriterOptions (Pandoc (Meta [] [] []) contextBlocks)

    after = bookshelfCreds

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

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

    pandoc = Pandoc meta (docBlocks ++ dirBlocks)
      where
        dir  = last $ splitDirectories $ relPath context
        meta = Meta (pandocStr dir) [] []

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

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

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

    listShelfDoc (doc,meta) = listDocument docShelfHtml meta' doc' []
      where
        doc'         = dropExtension doc
        docShelfHtml = doc `addExtension` ".html"
        meta'        = fixTitle meta doc'

    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 ")"
          ]


    listOrdDoc doc = return $ Plain
      [Link (pandocStr doc) (doc, "View '" ++ doc ++ "'")]

    listDir dir = return $ Plain
      [ Link
          (pandocStr dir)
          (dir </> "index.html", "Go to directory '" ++ dir ++ "'")
      , LineBreak
      ]