module Main where

import           Control.Monad.Trans
import           Control.Monad.State
import           Control.Exception
import           Data.List
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 flags are stored in opts and other command line arguments
  -- are stored in args.
  runCommand $ \opts args -> do
  
  -- Reads the flags
  case flagVersion opts of
    True -> putStrLn versionText
    False ->
      case args of
        [] -> runInputT defaultSettings ( outputStrLn initialText
                                          >> interpreterLoop defaultEnv
                                        )
        [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 "" -> EmptyLine
          Just input -> case parse interpreteractionParser "" input of
            Left _  -> Error
            Right a -> a

  -- Executes the parsed action, every action may affect the
  -- context in a way, and returns the control to the interpreter. 
  case interpreteraction of
    -- Interprets an action
    Interpret action -> case runState (act action) environment of
                          (output, newenv) -> do
                            outputActions newenv output
                            interpreterLoop newenv

    -- Loads a module and its dependencies given its name.
    -- Avoids repeated modules keeping only their first ocurrence.
    Load modulename -> do
      modules <- lift $ (nub <$> readAllModuleDepsRecursively [modulename])
      files <- lift $ mapM findFilename modules

      -- Concats all the module contents
      maybeactions <- (fmap concat) . sequence <$> (lift $ mapM loadFile files)
      case maybeactions of
        Nothing -> do
          outputStrLn "Error loading file"
          interpreterLoop environment
        Just actions -> case runState (multipleAct actions) environment of
                          (output, newenv) -> do
                            outputActions newenv output
                            interpreterLoop newenv
    
    -- Ignores the empty line
    EmptyLine -> interpreterLoop environment
    
    -- Exists the interpreter
    Quit -> return ()

    -- Restarts the interpreter context
    Restart -> interpreterLoop defaultEnv

    -- Unknown command
    Error -> do
      outputStr (if getColor environment then formatFormula else "")
      outputStrLn "Unknown command"
      outputStr end
      interpreterLoop environment

    -- Sets the verbose option
    SetVerbose setting -> do
      outputStrLn $
        (if getColor environment then formatFormula else "") ++
        "verbose mode: " ++ if setting then "on" else "off" ++
        end
      interpreterLoop (changeVerbose environment setting)
      
    -- Sets the color option
    SetColor setting -> do
      outputStrLn $
        (if getColor environment then formatFormula else "") ++
        "color mode: " ++ if setting then "on" else "off" ++
        end
      interpreterLoop (changeColor environment setting)

    -- Sets the ski option
    SetSki setting -> do
      outputStrLn $
        (if getColor environment then formatFormula else "") ++
        "ski mode: " ++ if setting then "on" else "off" ++
        end
      interpreterLoop (changeSkioutput environment setting)

    -- Sets the types option
    SetTypes setting -> do
      outputStrLn $
        (if getColor environment then formatFormula else "") ++
        "types: " ++ if setting then "on" else "off" ++
        end
      interpreterLoop (changeTypes environment setting)

    -- Prints the help
    Help -> outputStr helpText >> interpreterLoop environment




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

    formatColor s
      | getColor environment = s
      | otherwise            = unlines $ map decolor $ lines s
    
    formatVerbose "" = ""
    formatVerbose s
      | not (getVerbose environment) = (++"\n") . last . lines $ s
      | otherwise                    = 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 :: String -> 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 "") $ 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 . format) outputs
                      where
                        format :: String -> String
                        format "" = ""
                        format s = (++"\n") . last . lines $ s


-- | 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
readAllModuleDeps :: [Modulename] -> IO [Modulename]
readAllModuleDeps modulenames = do
  files <- mapM findFilename modulenames
  deps <- mapM readFileDependencies files
  return $ concat deps

-- | Read module dependencies recursively
readAllModuleDepsRecursively :: [Modulename] -> IO [Modulename]
readAllModuleDepsRecursively modulenames = do
  newmodulenames <- readAllModuleDeps modulenames
  let allmodulenames = nub (newmodulenames ++ modulenames)
  if modulenames == allmodulenames
    then return modulenames
    else readAllModuleDepsRecursively allmodulenames

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

  -- Looks for the module in the common locations
  head <$> filterM doesFileExist
    [ "lib/" ++ s ++ ".mkr"
    , "./" ++ s ++ ".mkr"
    , appdir ++ "/" ++ s ++ ".mkr"
    , homedir ++ "/" ++ s ++ ".mkr"
    ]


-- Flags
-- | Flags datatype
data MainFlags = MainFlags
  { flagExec :: String
  , flagVersion :: 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"