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

module Main where



import Control.Monad
import Data.List
import Data.Traversable (traverse)
import System.Directory
import System.FilePath

import System.Console.ParseArgs

import Text.CSL (parseCSL, readBiblioFile)
import Text.CSL.Data (getDefaultCSL)
import Text.Pandoc (getDefaultTemplate)
import Text.Pandoc.UTF8 (toStringLazy)

import Types
import Generate



-- | Makes a file path relative to a directory. Both supplied paths are assumed to be absolute, and
-- not including "..". Such paths are returned by 'canonicalizePath'.
makeRel
    :: FilePath  -- ^ Directory
    -> FilePath  -- ^ File
    -> FilePath
makeRel dir file = joinPath $ rel (splitDirectories dir) (splitDirectories file)
  where
    rel [] fs                = fs
    rel (d:ds) (f:fs) | d==f = rel ds fs
    rel ds fs                = replicate (length ds) ".." ++ fs

downPath :: FilePath -> FilePath
downPath f
    | isAbsolute f = f
    | isHttp f     = f
    | otherwise    = ".." </> f

-- | Move down to the given directory (affects paths in `Context`).
moveDown :: Context -> FilePath -> Context
moveDown context dir = context
    { relPath_ = relPath context </> dir
    , cssLink_ = fmap downPath $ cssLink context
    }



-- | @getDirectoryContentsSeparated path = (dirs, files)@
--
-- Returns the files and directories under @path@:
--
-- @dirs@ is a list of all directories (@.@ and @..@ excluded);
-- @files@ is a list of all files.
getDirectoryContentsSeparated :: FilePath -> IO ([FilePath], [FilePath])
getDirectoryContentsSeparated path = do
    conts  <- getDirectoryContents path
    isDirs <- sequence [ doesDirectoryExist (path </> cont) | cont <- conts]

    let files = [cont | (cont,isDir) <- zip conts isDirs, not isDir, relevant cont]
        dirs  = [cont | (cont,isDir) <- zip conts isDirs, isDir, relevant cont]

    return (dirs,files)
  where
    relevant x = not ("." `isPrefixOf` x)



-- | @getShelfContents path = (shelfs, infos, ords, dirs)@
--
-- Returns the documents and directories under @path@:
--
-- @shelfs@ is a list of all shelf documents that are not info documents.
--
-- @infos@ is a list of ordinary documents that have associated info documents.
--
-- @ords@ is a list of ordinary documents that don't have associated info
-- documents.
--
-- @dirs@ is a list of all directories (@.@ and @..@ excluded).
--
-- Files/directories with an associated @.ignore@ file are excluded from the
-- results.
getShelfContents :: FilePath -> IO ([FilePath], [FilePath], [FilePath], [FilePath])
getShelfContents path = do
    (ds,fs) <- getDirectoryContentsSeparated path

    let (ignores,fs') = partition ((".ignore"==) . takeExtension) fs
        ignores'      = map dropExtension ignores
        files         = filter (`notElem` ignores') fs'
        dirs          = filter (`notElem` ignores') ds

        (possShelfs,nonShelfs) = partition ((".shelf"==) . takeExtension) files
        possInfos              = map (flip replaceExtension "shelf") nonShelfs

        hasInfo file = replaceExtension file "shelf" `elem` possShelfs
        hasMain file = file `elem` possInfos
        (infos,ords) = partition hasInfo nonShelfs
        shelfs       = filter (not . hasMain) possShelfs

    return (shelfs,infos,ords,dirs)



-- | Removes the file @index.html@ (if existing) and files with the extension
-- @.shelf.html@ from the given directory.
clearPreviouslyGenerated :: FilePath -> IO ()
clearPreviouslyGenerated path = do
    (_,files) <- getDirectoryContentsSeparated path
    let prevFiles = filter prevGenerated files
    mapM_ (removeFile . (path</>)) prevFiles
  where
    prevGenerated file = file=="index.html" || shelfHtml
      where
        (init,ext1) = splitExtension file
        ext2        = takeExtension init
        shelfHtml   = ext1==".html" && ext2==".shelf"

-- | Converts the markdown file @file@ to the HTML file @file.html@ and returns
-- meta information for the document.
convertShelfDoc :: ShelfInfo -> IO MetaInfo
convertShelfDoc shelfInfo = do
    let name = shelfDocument shelfInfo
    markdown <- readFile name
    let (html,links,meta) = markdownToHtml shelfInfo markdown
    writeFile (name ++ ".html") html
    forM_ links $ \link -> do
      existsFile <- doesFileExist link
      existsDir  <- doesDirectoryExist link
      unless (existsFile || existsDir) $ warn link
    return meta
  where
    warn link = putStrLn $ concat
      [ "*Warning: link '"
      , link
      , "' does not exist in '"
      , (relPath shelfInfo </> shelfDocument shelfInfo)
      , "'."
      ]



-- | Generates the (sub-)bookshelf in the directory @rootPath\</\>relPath@ (see
-- 'Context').
generateBookshelf :: Context -> IO ()
generateBookshelf context = do
    clearPreviouslyGenerated path
    (shelfs,infos,ords,dirs) <- getShelfContents path
    setCurrentDirectory path
    shelfMetas <- mapM (convertShelfDoc . shelfInfoS) shelfs
    infoMetas  <- mapM (convertShelfDoc . shelfInfoI) infos
    writeFile "index.html" $ makeIndex
      context
      (zip shelfs shelfMetas)
      (zip infos  infoMetas)
      ords
      dirs
    mapM_ (generateBookshelf . moveDown context) dirs
  where
    path = rootPath context </> relPath context

    shelfInfoS name = ShelfInfo context Nothing name
    shelfInfoI name = ShelfInfo context (Just name) (replaceExtension name ".shelf")



argSpec :: [Arg String]
argSpec =
    [ Arg { argIndex = "Bib"
          , argName  = Just "bib"
          , argAbbr  = Just 'b'
          , argData  = argDataOptional "bibliography file" ArgtypeString
          , argDesc  = "Path to bibliography file"
          }

    , Arg { argIndex = "CSL"
          , argName  = Just "csl"
          , argAbbr  = Nothing
          , argData  = argDataOptional "CSL file" ArgtypeString
          , argDesc  = "Path to CSL style file"
          }

    , Arg { argIndex = "CSS"
          , argName  = Just "css"
          , argAbbr  = Just 'c'
          , argData  = argDataOptional "CSS file" ArgtypeString
          , argDesc  = "Path or URL to CSS style sheet"
          }

    , Arg { argIndex = "MathJax"
          , argName  = Just "mathjax"
          , argAbbr  = Just 'm'
          , argData  = argDataOptional "MathJax.js file" ArgtypeString
          , argDesc  = "URL to MathJax.js file (use \"\" to get the default URL)"
          }

    , Arg { argIndex = "MathML"
          , argName  = Just "mathml"
          , argAbbr  = Nothing
          , argData  = Nothing
          , argDesc  = "Use MathML for math rendering"
          }

    , Arg { argIndex = "Source"
          , argName  = Nothing
          , argAbbr  = Nothing
          , argData  = argDataRequired "source" ArgtypeString
          , argDesc  = "Root directory of bookshelf to be generated"
          }
    ]



main :: IO ()
main = do
    args  <- parseArgsIO ArgsComplete argSpec
    tmpl  <- getDefaultTemplate Nothing "html"
    tmpl' <- case tmpl of
        Left msg   -> error $ show msg
        Right tmpl -> return tmpl

    let bib = getArg args "Bib"
        csl = getArg args "CSL"

    cStyle <- fmap parseCSL $ case csl of
        Just cslFile -> readFile cslFile
        _            -> fmap toStringLazy getDefaultCSL

    refs <- case bib of
        Nothing -> return []
        Just bibFile -> readBiblioFile bibFile

    let Just path = getArg args "Source"
        css       = getArg args "CSS"
        mathjax   = getArg args "MathJax"
        mathml    = gotArg args "MathML"

    isDir <- doesDirectoryExist path
    unless isDir $ error $ "**Error: Source directory '" ++ path ++ "' does not exist."
    absPath <- canonicalizePath path

    let fixPath f
          | isHttp f  = return f
          | otherwise = do
              absf <- canonicalizePath f
              return $ if isAbsolute path || isAbsolute f
                then absf
                else makeRel absPath absf

    css' <- traverse fixPath css

    let dirs    = splitDirectories absPath
        context = Context tmpl' cStyle refs css' mathjax mathml (joinPath $ init dirs) (last dirs)

    generateBookshelf context