module Main where

import           Control.Monad.Trans
import           Control.Monad.State
import           Control.Exception
import           Data.List
import           Data.Foldable (forM_)
import           System.Directory
import           System.Console.Haskeline
import           Text.ParserCombinators.Parsec hiding (try)
import           Format
import           Interpreter
import           Environment
import           Options hiding (defaultOptions)


-- Lambda interpreter.
-- The actions of the interpreter are written here. It allows to execute normal
-- actions (bindings and evaluation), and interpreter specific actions, as "quit"
-- or "load".


-- | Runs the interpreter with default settings and an empty context.
main :: IO ()
main =
  -- Uses the Options library, which requires the program to start
  -- with runCommand. The command-line flags are stored in opts and
  -- other command line arguments are stored in args.
  runCommand $ \opts args -> do
  -- Reads the libaries flag. If activated, it will not automatically
  -- load the libraries.
  let initialEnv = if flagLibs opts then defaultEnv else librariesEnv
  -- Reads the rest of the flags. The --version flag shows the current
  -- version of the interpreter. An optional argument may be used to
  -- indicate a file to load.
  if flagVersion opts
  then putStrLn versionText
  else case args of
             [] ->
               runInputT
                 defaultSettings
                 (outputStrLn initialText >> interpreterLoop initialEnv)
             [filename] -> executeFile filename
             _ -> putStrLn "Wrong number of arguments"

-- | Interpreter awaiting for an instruction.
interpreterLoop :: Environment -> InputT IO ()
interpreterLoop environment = do
  -- Gets the user input on the interpreter
  -- and parses it to a concrete action.
  minput <- getInputLine promptText
  let interpreteraction =
        case minput of
          Nothing -> Quit
          Just "" -> Interpret EmptyLine
          Just input ->
            case parse interpreteractionParser "" (preformat input) of
              Left  _ -> Interpret Error
              Right a -> a

  newenvironment <- executeAction environment interpreteraction
  forM_ newenvironment interpreterLoop
              

-- | Executes the parsed action, every action may affect the context
-- in a way, and returns the control to the interpreter.
executeAction :: Environment -> InterpreterAction -> InputT IO (Maybe Environment)
executeAction environment interpreteraction = 
  case interpreteraction of
    -- Interprets an action
    Interpret action ->
      case runState (act action) environment of
        (output, newenv) -> do
          outputActions newenv output
          return $ Just newenv
    -- Loads a module and its dependencies given its name.
    -- Avoids repeated modules keeping only their first ocurrence.
    Load modulename -> do
      readallmoduledeps <- lift $ readAllModuleDepsRecursively [modulename]
      case readallmoduledeps of
        Nothing -> do
          outputStrLn errorNotFoundText
          return $ Just environment
        Just readallmodules -> do
          let modules = nub readallmodules
          files <- lift $ mapM findFilename modules
          -- Concats all the module contents
          case sequence files of
            Nothing -> do
              outputStrLn errorNotFoundText
              return $ Just environment
            Just allfiles -> do
              maybeactions <- fmap concat . sequence <$> lift (mapM loadFile allfiles)
              case maybeactions of
                Nothing -> do
                  outputStrLn "Error loading file"
                  return $ Just environment
                Just actions ->
                  case runState (multipleAct actions) environment of
                    (output, newenv) -> do
                      outputActions newenv output
                      return $ Just newenv
    -- Exits the interpreter
    Quit -> return Nothing



-- | Outputs results from actions. Given a list of options and outputs,
--   formats and prints them in console.
outputActions :: Environment -> [String] -> InputT IO ()
outputActions environment output = do
    outputStr (if getColor environment then formatFormula else "")
    mapM_ (outputStr . format) output
    outputStr end
  where
    format = formatColor
    formatColor s
      | getColor environment = s
      | otherwise            = unlines $ map decolor $ lines s



-- Loading and reading files
-- | Loads the given filename and returns the complete list of actions.
--   Returns Nothing if there is an error reading or parsing the file.
loadFile :: Filename -> IO (Maybe [Action])
loadFile filename = do
  putStrLn $ formatLoading ++ "Loading " ++ filename ++ "..." ++ end
  input <- try $ readFile filename :: IO (Either IOException String)
  case input of
    Left _ -> return Nothing
    Right inputs -> do
      let parsing = map (parse actionParser "" . preformat) . filter (/="") . lines $ inputs
      let actions = map (\x -> case x of
                                 Left _  -> Nothing
                                 Right a -> Just a) parsing
      return $ sequence actions

-- | Executes the commands inside a file. A .mkr file can contain a sequence of
--   expressions and variable bindings, and it is interpreted sequentially.
executeFile :: Filename -> IO ()
executeFile filename = do
  maybeloadfile <- loadFile filename
  case maybeloadfile of
    Nothing -> putStrLn "Error loading file"
    Just actions ->
      case runState (multipleAct actions) defaultEnv of
        (outputs, _) -> mapM_ putStr outputs

-- | Reads module dependencies
readFileDependencies :: Filename -> IO [Modulename]
readFileDependencies filename = do
  input <- try $ readFile filename :: IO (Either IOException String)
  case input of
    Left _ -> return []
    Right inputs -> return $
      map (drop 9) (filter (isPrefixOf "#INCLUDE ") $ filter (/="") $ lines inputs)

-- | Reads all the dependencies from a module list.
--   Returns an error if a dependency cannot be found
readAllModuleDeps :: [Modulename] -> IO (Maybe [Modulename])
readAllModuleDeps modulenames = do
  files <- mapM findFilename modulenames
  deps <- mapM (mapM readFileDependencies) files
  return (concat <$> sequence deps)

-- | Read module dependencies recursively.
--   Returns an error if a dependency cannot be found
readAllModuleDepsRecursively :: [Modulename] -> IO (Maybe [Modulename])
readAllModuleDepsRecursively modulenames = do
  maybenewmodulenames <- readAllModuleDeps modulenames
  case maybenewmodulenames of
    Nothing -> return Nothing
    Just newmodulenames -> do
      let allmodulenames = nub (newmodulenames ++ modulenames)
      if modulenames == allmodulenames
      then return (Just modulenames)
      else readAllModuleDepsRecursively allmodulenames

-- | Given a module name, returns the filename associated with it
findFilename :: Modulename -> IO (Maybe Filename)
findFilename s = do
  appdir <- getAppUserDataDirectory "mikrokosmos"
  homedir <- getHomeDirectory

  -- Looks for the module in the common locations
  headMaybe <$> filterM doesFileExist
    [ "lib/" ++ s ++ ".mkr"
    , "./" ++ s ++ ".mkr"
    , appdir ++ "/" ++ s ++ ".mkr"
    , homedir ++ "/" ++ s ++ ".mkr"
    , "/usr/lib/mikrokosmos/" ++ s ++ ".mkr"
    ]
  where
    headMaybe [] = Nothing
    headMaybe (x:_) = Just x


-- | Flags datatype
data MainFlags = MainFlags
  { flagExec :: String
  , flagVersion :: Bool
  , flagLibs :: Bool
  }

instance Options MainFlags where
  -- | Flags definition
  defineOptions = pure MainFlags
    <*> simpleOption "exec"    ""    "A file to execute and show its results"
    <*> simpleOption "version" False "Show program version"
    <*> simpleOption "no-libs" False "Runs mikrokosmos without standard libraries"