module Main where

import System             (getProgName, getArgs)
import System.CurryPath   (lookupModuleSourceInLoadPath, stripCurrySuffix)
import Directory          (doesFileExist, getHomeDirectory)
import FilePath           ( (</>) )

import Curry.Files        (readFullAST)
import Curry.Types
import Curry.Position
import Curry.SpanInfo
import Curry.Span
import Curry.Ident

import Parse.CommandLine  (parseOpts, usageText)
import Parse.Config       (parseConfig, defaultConfig)
import State
import Types
import Check
import Pretty.ToString    (renderMessagesToString)
import Pretty.ToJson      (renderMessagesToJson)
import Pretty.ShowOptions (showOptions)

--TODO: structur to be renamed
--ERROR: Unknown unqualified symbol: Module
--ERROR: ReadShowTerm.readUnqualifiedTerm: no parse

-- Banner of this tool:
scBanner :: String
scBanner = unlines [bannerLine,bannerText,bannerLine]
 where
   bannerText = "Curry Style Checker (Version of 22/10/2019)"
   bannerLine = take (length bannerText) (repeat '-')

-- URL containing Curry style guide:
styleGuideURL :: String
styleGuideURL = "http://www.informatik.uni-kiel.de/~curry/style/"

--commandline
main :: IO ()
main = getCheckOpts >>= styleCheck

--start programm with arguments from commandline,
--if the file to check is found, find config, if specified in
--commandlineoptions. If config not used or not found, use defaultConfig
--get spanAST and src of code and run checkAll on these two files,
--returned String (Messages) are put into console output
styleCheck :: Arguments -> IO ()
styleCheck a@(_, flags, _) = do
  config <- getConfig flags >>= updateConfigWithOpts flags
  restrict config 1 scBanner
  restrict config 3 (showOptions config)
  if Help `elem` flags
    then putStrLn $ usageText ++ "\nSee also the Curry Style Guide at\n\n    "
                    ++ styleGuideURL
    else styleCheck' a config

styleCheck' :: Arguments -> Config -> IO ()
styleCheck' (_, _, []) config =
  restrict config 1 "All given files checked.\n"
styleCheck' (p, o, (fileName:files)) config  = do
  let modName = stripCurrySuffix fileName
  restrict config 2 $ "--------------------------------\n"
                      ++ "INFO: Reading module " ++ modName
  filePaths <- lookupModuleSourceInLoadPath modName
  case filePaths of
    Nothing           -> do putStrLn $ "WARNING: "
                                       ++ modName
                                       ++ " does not exist\n"
                            styleCheck' (p, o, files) config
    Just (_,filePath) -> do
      ast <- getAST modName config
      src <- getSrc filePath config
      restrict config 2  $ "INFO: Checking style of file " ++ modName
      messages <- return (checkAll src ast config modName (getOutputOption config))
      restrict config 1 $ "--------------------------------\n"
                ++ modName ++ "\n"
                ++ "--------------------------------\n"
      restrict config 0 $ messages ++"\n"
      styleCheck' (p, o, files) config

-- determines output function by configuration
getOutputOption :: Config -> (Config -> String -> [SrcLine] -> [Message] -> String)
getOutputOption c = case oType c of
  JSON -> renderMessagesToJson
  TEXT -> renderMessagesToString

-- update config after reading the currystylecheckrc by updating according to the flag
updateConfigWithOpts :: [Flag] -> Config -> IO Config
updateConfigWithOpts []     conf = return conf
updateConfigWithOpts (f:fs) conf@(Config checks out verb hint code maxLength) = case f of
  (Ignore s)              -> do
    newCheckl <- updateChecks s checks False conf
    updateConfigWithOpts fs (Config newCheckl out verb hint code maxLength)
  (Add s)                 -> do
    newCheckl <- updateChecks s checks True conf
    updateConfigWithOpts fs (Config newCheckl out verb hint code maxLength)
  (OType "JSON")          ->
    updateConfigWithOpts fs (conf {oType = JSON})
  (OType "TEXT")          ->
    updateConfigWithOpts fs (conf {oType = TEXT})
  (Verbosity i)           ->
    updateConfigWithOpts fs (conf {verbosity = (if ((i < 4) && (i > -1)) then i else 1)})
  _                       -> updateConfigWithOpts fs conf

-- update one check according to given string (check name) and bool
updateChecks :: String -> CheckList -> Bool -> Config -> IO CheckList
updateChecks s checkl b c = case s of
  "tabs"              -> return checkl {tab = b}
  "lineLength"        -> return checkl {lineLength = b}
  "tabs"              -> return checkl {tab = b}
  "ifThenElse"        -> return checkl {ifThenElse = b}
  "case"              -> return checkl {caseIndent = b}
  "do"                -> return checkl {doIndent = b}
  "let"               -> return checkl {letIndent = b}
  "guard"             -> return checkl {guardIndent = b}
  "functionRhs"       -> return checkl {rhsAlign = b}
  "equalsTrue"        -> return checkl {equalstrue = b}
  "signatures"        -> return checkl {topLevelSig = b}
  "blankLines"        -> return checkl {blankLines = b}
  "trailingSpaces"    -> return checkl {trailingS = b}
  "whiteSpaces"       -> return checkl {whiteSpace = b}
  "moduleHeader"      -> return checkl {moduleheader = b}
  "imports"           -> return checkl {imports = b}
  "data"              -> return checkl {dataIndent = b}
  "list"              -> return checkl {listIndent = b}
  "thentrueelsefalse" -> return checkl {thenTrueElseFalse = b}
  "notEqual"          -> return checkl {notEqual = b}
  "notOrd"            -> return checkl {notOrd = b}
  "equalsEmptyList"   -> return checkl {equalsEmptyList = b}
  "identFunc"         -> return checkl {identFunc = b}
  "constFunc"         -> return checkl {constFunc = b}
  "andOr"             -> return checkl {andOr = b}
  "print"             -> return checkl {printCheck = b}
  "deriving"          -> return checkl {derivingIndent = b}
  "class"             -> return checkl {classIndent = b}
  "instance"          -> return checkl {instanceIndent = b}
  _                   -> do restrict c 2
                              ( "WARNING: tried to "
                                ++ (if b then "add" else "ignore")
                                ++ " an invalid check \180"
                                ++ s
                                ++ "\180, passing over")
                            return checkl

-- only print s if the current verbosity isn't lower than its restriction
restrict :: Config -> Int -> String -> IO ()
restrict conf i s = whenM ((verbosity conf) >= i)
                          (putStrLn s)

------------------------------------------------------------------------------
-- Name of the config file for the style checker.
configFileName :: String
configFileName = "currystylecheckrc"

-- loads currystylecheckrc first from local directory, if not existing
-- from home and at last creates a default configuration
getConfig :: [Flag] -> IO Config
getConfig flags = do
  iconfig <- updateConfigWithOpts flags defaultConfig
  home <- getHomeDirectory
  configExistsHere <- doesFileExist (configFileName)
  if configExistsHere
    then parseConfig (verbosity iconfig > 1) (configFileName)
    else do
      restrict iconfig 2 $ "INFO: config file not found in current directory,"
                           ++ " searching home directory"
      configExistsHome <- doesFileExist $ home </> configFileName
      if configExistsHome
        then parseConfig (verbosity iconfig > 1) $ home </> configFileName
        else do
          restrict iconfig 2 $ "INFO: config file not found in home directory,"
                               ++ " using default settings"
          return defaultConfig

--gets filename and config,
--if any check on AST is on (config), then get the Ast of the programm
--if the curry file has a suffix .curry, remove it to find corresponding
--AST
--if no check needed, return an empty module to avoid reading time of SpanAST
getAST :: String -> Config -> IO (Module ())
getAST fileName config =
  if (anyAST config)
    then do restrict config 2 $ "INFO: Getting SpanAST of " ++ fileName
            ast <- readFullAST fileName
            const done $!! ast
            return ast
    else return (Module
                  (SpanInfo (Span (Position 1 1) (Position 1 1)) [])
                  []
                  (ModuleIdent NoSpanInfo ["NoAST"])
                  Nothing
                  []
                  []
                )

--gets filename and config, if any check on src is on (config),
--return the sourcecode in form of a list of lines, which
--are indexed strings
getSrc :: String -> Config -> IO [(Int,String)]
getSrc fileName config =
  if (anySrc config)
    then do restrict config 2 $ "INFO: Parsing file " ++ fileName
            ls <- readFile (fileName) >>= return . lines
            let src = zip [1..(length ls)] ls
            return $ filter (\(_,l) -> (length l) > 0) src
    else return []

-- Retrieve the programmname and commandline arguments,
-- parse and return name, flags and further informations
getCheckOpts :: IO Arguments
getCheckOpts = do
  args  <- getArgs
  prog  <- getProgName
  (o,n) <- parseOpts args
  return (prog, o, n)