----------------------------------------------------------------------
--- Implementation of CurryDoc, a utility for the automatic
--- generation of HTML documentation from Curry programs.
---
--- @author Michael Hanus, Jan Tikovsky
--- @version December 2020
----------------------------------------------------------------------

-- * All comments to be put into the HTML documentation must be
--   prefixed by "--- " (also in literate programs!).
--
-- * The comment of a module must occur before the first "module" or
--   "import" line of this module.
--
-- * The comment of a function or datatype must occur before the
--   first definition of this function or datatype.
--
-- * The comments can contain at the end several special comments:
--   @cons id comment   --> a comment for a constructor of a datatype
--   @param id comment  --> comment for function parameter id
--                          (list all parameters in left-to-right order)
--   @return comment    --> comments for the return value of a function
--   @author comment    --> the author of a module (only in module comments)
--   @version comment   --> the version of a module (only in module comments)
--
-- * Current restriction: doesn't properly work for infix operator definitions
--   without a type definition (so it should be always included)

module CurryDoc.Main where

import Control.Monad      ( unless, when )
import Data.Function
import Data.List
import Data.Maybe         ( fromJust )
import System.Environment

import Data.Time
import HTML.Base
import System.Directory
import System.FilePath
import System.Process

import AbstractCurry.Files
import FlatCurry.Types
import FlatCurry.Files
import FlatCurry.Read     ( readFlatCurryWithImports )

import Analysis.Deterministic
import Analysis.TotallyDefined
import Analysis.Indeterministic
import Analysis.SolutionCompleteness
import Analysis.Types      ( analysisName )
import CASS.Server         ( initializeAnalysisSystem, analyzeInterface )
import System.CurryPath    ( stripCurrySuffix, lookupModuleSourceInLoadPath
                           , getLoadPathForModule )
import System.FrontendExec ( FrontendTarget (..), callFrontend )

import CurryDoc.AnaInfo
import CurryDoc.Files   ( generateModuleDocMapping )
import CurryDoc.Options
import CurryDoc.Read
import CurryDoc.Html
import CurryDoc.TeX
import CurryDoc.CDoc
import CurryDoc.Config
import CurryDoc.PackageConfig ( packagePath )

--------------------------------------------------------------------------
-- Global definitions:

banner :: String
banner = unlines [bannerLine,bannerText,bannerLine]
 where
 bannerText =
  "CurryDoc (" ++ currydocVersion ++ ") - the Curry Documentation Tool"
 bannerLine = take (length bannerText) (repeat '-')

-- Directory where include files for generated documention (e.g., icons,
-- css, tex includes) are stored:
includeDir :: String
includeDir = packagePath </> "include"

--------------------------------------------------------------------------
-- Check arguments and call main function:
main :: IO ()
main = do
  args <- getArgs
  putStrLn banner
  processArgs defaultCurryDocOptions args

processArgs :: DocOptions -> [String] -> IO ()
processArgs opts args = do
  case args of
    -- no markdown
    ("--nomarkdown" : margs) -> processArgs opts { withMarkdown = False } margs
    -- documentation type
    ("--title" : t : margs) -> processArgs opts { mainTitle = t } margs
    ("--use"   : t : margs) ->
       let (src,url) = break (=='@') t
       in if null url
            then error "URL missing in --use option!"
            else processArgs opts { useDirURL = useDirURL opts ++
                                                    [(src,tail url)] } margs
    ("--html"      : margs) -> processArgs opts { docType = HtmlDoc } margs
    ("--tex"       : margs) ->
      processArgs opts { docType = TexDoc, withIndex = False } margs
    ("--cdoc"      : margs) ->
      processArgs opts { docType = CDoc,   withIndex = False } margs
    -- HTML without index
    ["--noindexhtml",docdir,modname] -> do
        opts' <- processOpts opts { withIndex = False, docType = HtmlDoc }
        makeCompleteDoc opts' True docdir (stripCurrySuffix modname)
    -- HTML index only
    ("--onlyindexhtml":docdir:modnames) -> do
        opts' <- processOpts opts
        makeIndexPages opts' docdir (map stripCurrySuffix modnames)
    ("--libsindexhtml":docdir:modnames) -> do
        opts' <- processOpts opts
        makeSystemLibsIndex opts' docdir modnames
    (('-':_):_) -> printUsageMessage
    -- module
    [modname] -> do
        opts' <- processOpts opts
        makeCompleteDoc opts' (docType opts == HtmlDoc)
                        ("DOC_" ++ stripCurrySuffix (takeFileName modname))
                        (stripCurrySuffix modname)
    -- docdir + module
    [docdir,modname] -> do
        opts' <- processOpts opts
        makeCompleteDoc opts' (docType opts == HtmlDoc) docdir
                        (stripCurrySuffix modname)
    _ -> printUsageMessage

-- Process the original user options into the form required by CurryDoc.
processOpts :: DocOptions -> IO DocOptions
processOpts opts = do
  modurls <- generateModuleDocMapping (useDirURL opts)
  return $ opts { docMods = map fst modurls
                , docURL  = \m -> maybe m (\b -> b </> m) (lookup m modurls) }

printUsageMessage :: IO ()
printUsageMessage = do
  args <- getArgs
  putStrLn $ unlines
   [ "ERROR: Illegal arguments for CurryDoc: " ++ unwords args
   , ""
   , "Usage:"
   , "curry-doc <options> [--html|--tex|--cdoc] [<doc_dir>] <module>"
   , "curry-doc <options> --noindexhtml   <doc_dir> <module>"
   , "curry-doc <options> --onlyindexhtml <doc_dir> <modules>"
   , "curry-doc <options> --libsindexhtml <doc_dir> <modules>"
   , ""
   , "where <options> can be:"
   , "  --title s    : Title of the main HTML documentation page"
   , "  --use dir@url: use for all Curry programs in <dir> the documentation"
   , "                 already stored at <url>"
   , "  --nomarkdown : do not process markdown code in comments"
   ]


-- create directory if not existent:
createDir :: String -> IO ()
createDir dir = do
  exdir <- doesDirectoryExist dir
  unless exdir $ system ("mkdir -p " ++ dir) >> return ()

--- Recursively copies a directory structure.
copyDirectory :: String -> String -> IO ()
copyDirectory src dst = do
  retCode <- system $ "cp -pR \"" ++ src ++ "\" \"" ++ dst ++ "\""
  when (retCode /= 0) $
    error $ "Copy failed with return code " ++ show retCode

--------------------------------------------------------------------------
--- The main function of the CurryDoc utility.
--- @param docopts   - the options for CurryDoc
--- @param recursive - True if the documentation for the imported modules
---                    should be also generated (if necessary)
--- @param docdir - the directory name containing all documentation files
--- @param modname - the name of the main module to be documented
makeCompleteDoc :: DocOptions -> Bool -> String -> String -> IO ()
makeCompleteDoc docopts recursive reldocdir modpath = do
  docdir <- makeAbsolute reldocdir
  prepareDocDir (docType docopts) docdir
  lookupModuleSourceInLoadPath modpath >>=
   maybe (error $ "Source code of module '" ++ modpath ++ "' not found!")
    (\ (moddir,_) -> do
      let modname = takeFileName modpath
          homeref = ("index.html", [htxt "Program", nbsp, code [htxt modname]])
      setCurrentDirectory moddir
      -- parsing source program:
      callFrontend FCY modname
      -- generate abstract curry representation
      callFrontend ACY modname
      -- when constructing CDOC the imported modules don't have to be read
      -- from the FlatCurry file
      (alltypes,allfuns) <- getProg modname $ docType docopts
      makeDocIfNecessary docopts recursive docdir modname
      when (withIndex docopts) $ do
        genMainIndexPage     docopts docdir [modname]
        genFunctionIndexPage homeref docopts docdir allfuns
        genConsIndexPage     homeref docopts docdir alltypes
      -- change access rights to readable for everybody:
      system ("chmod -R go+rX "++docdir)
      putStrLn ("Documentation files written into directory "++docdir) )
 where
  getProg modname HtmlDoc = readTypesFuncsWithImports modname
  getProg modname TexDoc  = readTypesFuncsWithImports modname
  getProg modname CDoc    = do (Prog _ _ types funs _) <- readFlatCurry modname
                               return (types,funs)

--- Transform a file path into an absolute file path:
makeAbsolute :: String -> IO String
makeAbsolute f =
  if isAbsolute f
    then return f
    else do curdir <- getCurrentDirectory
            return (curdir </> f)

--- Generate only the index pages for a list of (already compiled!) modules:
makeIndexPages :: DocOptions -> String -> [String] -> IO ()
makeIndexPages docopts docdir modnames = do
  prepareDocDir HtmlDoc docdir
  (alltypes,allfuns) <- mapM readTypesFuncs modnames >>= return . unzip
  genMainIndexPage     docopts docdir modnames
  genFunctionIndexPage homeref docopts docdir (concat allfuns)
  genConsIndexPage     homeref docopts docdir (concat alltypes)
  -- change access rights to readable for everybody:
  system $ "chmod -R go+rX " ++ docdir
  return ()
 where
  hometitle = if null (mainTitle docopts)
                then "Curry Documentation"
                else mainTitle docopts

  homeref = ("index.html", [htxt hometitle])

  readTypesFuncs modname = do
    fcyfile <- getFlatCurryFileInLoadPath modname
    (Prog _ _ types funs _) <- readFlatCurryFile fcyfile
    return (types,funs)

--- Generate a system library index page categorizing the given
--- (already compiled!) modules
makeSystemLibsIndex :: DocOptions -> String -> [String] -> IO ()
makeSystemLibsIndex docopts docdir modnames = do
  -- generate index pages (main index, function index, constructor index)
  makeIndexPages docopts docdir modnames
  putStrLn ("Categorizing modules ...")
  modInfos <- mapM getModInfo modnames
  putStrLn ("Grouping modules by categories ...")
  let grpMods = map sortByName $ groupByCategory $ sortByCategory modInfos
      cats    = sortBy (<=) $ nub $ map fst3 modInfos
  genSystemLibsPage docdir cats grpMods
 where
  fst3 (x,_,_)    = x
  snd3 (_,y,_)    = y
  sortByCategory  = sortBy  ((<=) `on` fst3)
  groupByCategory = groupBy ((==) `on` fst3)
  sortByName      = sortBy  ((<=) `on` snd3)

getModInfo :: String -> IO (Category,String,String)
getModInfo modname = do
  mmodsrc <- lookupModuleSourceInLoadPath modname
  case mmodsrc of
    Nothing -> error $ "Source code of module '"++modname++"' not found!"
    Just (_,progname) -> do
      modcmts <- readModuleComment progname
      let (modcmt,catcmts) = splitComment modcmts
          category         = readCategory $ getCommentType "category" catcmts
      return (category,modname,firstPassage modcmt)

-- create documentation directory (if necessary) with gifs and stylesheets:
prepareDocDir :: DocType -> String -> IO ()
prepareDocDir HtmlDoc docdir = do
  createDir docdir
  -- copy style sheets etc:
  let docstyledir = docdir </> "bt4"
  exdir <- doesDirectoryExist docstyledir
  unless exdir $ copyDirectory (includeDir </> "bt4") docstyledir
prepareDocDir TexDoc docdir = do
  createDir docdir
  putStrLn $ "Copy macros into documentation directory '"++docdir++"'..."
  copyIncludeIfPresent docdir "currydoc.tex"
prepareDocDir CDoc docdir = do
  createDir docdir
  putStrLn "Directory was succesfully created"

copyIncludeIfPresent :: String -> String -> IO ()
copyIncludeIfPresent docdir inclfile = do
  existIDir <- doesDirectoryExist includeDir
  when existIDir $
    system (unwords ["cp", includeDir </> inclfile, docdir]) >> return ()

-- read and generate all analysis infos:
readAnaInfo :: String -> IO AnaInfo
readAnaInfo modname = do
  initializeAnalysisSystem
  nondet   <- analyzeAndCheck nondetAnalysis
  complete <- analyzeAndCheck patCompAnalysis
  indet    <- analyzeAndCheck indetAnalysis
  solcomp  <- analyzeAndCheck solcompAnalysis
  return (AnaInfo (\qn -> nondet qn == NDet) complete indet solcomp)
 where
   analyzeAndCheck ana =
     analyzeInterface ana modname >>= either
       (\results ->
           return (\qn -> maybe (error $ "No '" ++ analysisName ana ++
                                 "' analysis result for function " ++ show qn)
                                id
                                (lookup qn results)))
       (\err -> error $ "Analysis error: " ++ err)

-- generate documentation for a single module:
makeDoc :: DocOptions -> Bool -> String -> String -> IO ()
makeDoc docopts recursive docdir modname = do
  Just (_,progname) <- lookupModuleSourceInLoadPath modname
  putStrLn $ "Reading comments from file '" ++ progname ++ "'..."
  (modcmts,progcmts) <- readComments progname
  putStrLn $ "Reading analysis information for module \"" ++ modname ++ "\"..."
  anainfo <- readAnaInfo modname
  makeDocWithComments (docType docopts) docopts recursive docdir
                      anainfo modname modcmts progcmts


makeDocWithComments :: DocType -> DocOptions -> Bool -> String -> AnaInfo
                    -> String -> String -> [(SourceLine,String)] -> IO ()
makeDocWithComments HtmlDoc docopts recursive docdir anainfo modname
                    modcmts progcmts = do
  -- ensure that the AbstractCurry file for the module exists
  Just (dir,_) <- lookupModuleSourceInLoadPath modname
  let acyfile = dir </> abstractCurryFileName modname
  exacy <- doesFileExist acyfile
  unless exacy $ callFrontend ACY modname
  writeOutfile docopts recursive docdir modname
               (generateHtmlDocs docopts anainfo modname modcmts progcmts)
  translateSource2ColoredHtml docdir modname
  writeOutfile docopts { docType = CDoc, withIndex = False
                       , withMarkdown = False }
               False docdir modname
               (generateCDoc modname modcmts progcmts anainfo)

makeDocWithComments TexDoc docopts recursive docdir anainfo modname
                    modcmts progcmts = do
  writeOutfile docopts recursive docdir modname
               (generateTexDocs docopts anainfo modname modcmts progcmts)


makeDocWithComments CDoc docopts recursive docdir anainfo modname
                    modcmts progcmts = do
  writeOutfile docopts recursive docdir modname
               (generateCDoc modname modcmts progcmts anainfo)


--- Generates the documentation for a module if it is necessary.
--- I.e., the documentation is generated if no previous documentation
--- file exists or if the existing documentation file is older than
--- the FlatCurry file.
makeDocIfNecessary :: DocOptions -> Bool -> String -> String -> IO ()
makeDocIfNecessary docopts recursive docdir modname =
 when (modname `notElem` docMods docopts) $ do
  let docfile = docdir </> modname ++
                (if docType docopts == HtmlDoc then ".html" else ".tex")
  docexists <- doesFileExist docfile
  if not docexists
   then copyOrMakeDoc docopts recursive docdir modname
   else do
     ctime  <- getFlatCurryFileInLoadPath modname >>= getModificationTime
     dftime <- getModificationTime docfile
     if compareClockTime ctime dftime == GT
      then copyOrMakeDoc docopts recursive docdir modname
      else when recursive $ do
             imports <- getImports modname
             mapM_ (makeDocIfNecessary docopts recursive docdir) imports

-- get imports of a module by reading the interface, if possible:
getImports :: String -> IO [String]
getImports modname = do
  mbfintfile <- getLoadPathForModule modname >>=
                findFileWithSuffix (flatCurryIntName modname) [""]
  (Prog _ imports _ _ _) <- maybe
                             (getFlatCurryFileInLoadPath modname >>=
                              readFlatCurryFile)
                             readFlatCurryFile
                             mbfintfile
  return imports

copyOrMakeDoc :: DocOptions -> Bool -> String -> String -> IO ()
copyOrMakeDoc docopts recursive docdir modname = do
  hasCopied <- copyDocIfPossible docopts docdir modname
  unless hasCopied $ makeDoc docopts recursive docdir modname

--- Copy the documentation file from standard documentation directoy "CDOC"
--- (used for documentation of system libraries) if possible.
--- Returns true if the copy was possible.
copyDocIfPossible :: DocOptions -> String -> String -> IO Bool
copyDocIfPossible docopts docdir modname =
  if docType docopts == TexDoc
  then return False -- ignore copying for TeX docs
  else do
    mdir <- lookupModuleSourceInLoadPath modname >>= return . fst . fromJust
    let docprogname = mdir </> "CDOC" </> modname
        docHtmlFile = docprogname <.> "html"
    docexists <- doesFileExist docHtmlFile
    if not docexists
      then return False
      else do
        ctime <- getModificationTime (mdir </> flatCurryFileName modname)
        htime <- getModificationTime docHtmlFile
        if compareClockTime ctime htime == GT
          then return False
          else do
            putStrLn ("Copying doc file from " ++ docHtmlFile)
            system ("cp " ++ docHtmlFile ++ ' ':docdir)
            system ("cp " ++ docprogname ++ "_curry.html "++docdir)
            return True

-----------------------------------------------------------------------
-- auxiliaries:

-- reads all types and function declarations (also imported ones) of
-- a module:
readTypesFuncsWithImports :: String -> IO ([TypeDecl],[FuncDecl])
readTypesFuncsWithImports modname = do
  allprogs <- readFlatCurryWithImports modname
  let (ts,fs) = unzip (map (\ (Prog _ _ types funs _) -> (types,funs)) allprogs)
  return (concat ts, concat fs)

-- get the associated file extenstion from DocType
fileExtension :: DocType -> String
fileExtension HtmlDoc = "html"
fileExtension TexDoc  = "tex"
fileExtension CDoc    = "cdoc"

-- harmonized writeFile function for all docType
writeOutfile :: DocOptions -> Bool -> String -> String -> IO String -> IO ()
writeOutfile docopts recursive docdir modname generate = do
  doc     <- generate
  imports <- getImports modname
  let outfile = docdir </> modname <.> fileExtension (docType docopts)
  putStrLn ("Writing documentation to \"" ++ outfile ++ "\"...")
  writeFile outfile doc
  when recursive $
    mapM_ (makeDocIfNecessary docopts recursive docdir) imports

-- -----------------------------------------------------------------------