{-|
Module: Interpreter
Description: Internal logic of the interpreter
License: GPL-3

This module contains auxiliary logic, types and representations of
the internal state of the interpreter.
-}
module Interpreter
  ( Context
  , emptyContext
  , InterpreterOptions (InterpreterOptions)
  , defaultOptions
  , changeVerbose
  , changeColor
  , getVerbose
  , getColor
  , InterpreterAction (..)
  , interpreteractionParser
  , act
  , multipleAct
  , Action (..)
  , actionParser
  )
where

import           Control.Applicative           ((<$>), (<*>))
import           Control.Monad.State.Lazy      
import           Text.ParserCombinators.Parsec hiding (State)
import           Data.Char
import           Data.List
import           MultiBimap
import           NamedLambda
import           Format
import           Lambda

-- | A context is an application between expressions and the names
-- they may have.
type Context  = MultiBimap Exp String

-- | Empty context without any bindings
emptyContext :: Context
emptyContext = MultiBimap.empty


-- Interpreter options
-- | Configuration options for the interpreter. They can be changed dinamically.
data InterpreterOptions = InterpreterOptions
  { verbose :: Bool -- ^ true to produce verbose output
  , color :: Bool   -- ^ true to color the output
  }

-- | Default configuration options for the interpreter.
defaultOptions :: InterpreterOptions
defaultOptions = InterpreterOptions
  { verbose = False
  , color   = True
  }

-- | Gets the verbose configuration
getVerbose :: InterpreterOptions -> Bool
getVerbose = verbose

-- | Gets the color configuration
getColor :: InterpreterOptions -> Bool
getColor = color

-- | Sets the verbose configuration on/off.
changeVerbose :: InterpreterOptions -> InterpreterOptions
changeVerbose options = options {verbose = not $ verbose options}

-- | Sets the color configuration on/off
changeColor :: InterpreterOptions -> InterpreterOptions
changeColor options = options {color = not $ color options}





-- | Interpreter action. It can be a language action (binding and evaluation)
-- or an interpreter specific one, such as "quit". 
data InterpreterAction = Interpret Action -- ^ Language action
                       | EmptyLine        -- ^ Empty line, it will be ignored
                       | Error            -- ^ Error on the interpreter
                       | Quit             -- ^ Close the interpreter
                       | Load String      -- ^ Load the given file
                       | SetVerbose       -- ^ Changes verbosity
                       | SetColors        -- ^ Changes colors
                       | Help             -- ^ Shows help

-- | Language action. The language has a number of possible valid statements;
-- all on the following possible forms.
data Action = Bind (String, NamedLambda)     -- ^ bind a name to an expression
            | EvalBind (String, NamedLambda) -- ^ bind a name to an expression and simplify it
            | Execute NamedLambda            -- ^ execute an expression
            | Comment                        -- ^ comment


-- | Executes a language action. Given a context and an action, returns
-- the new context after the action and a text output.
act :: Action -> State Context [String]
act Comment = return [""]
act (Bind (s,le)) =
  do modify (\ctx -> MultiBimap.insert (toBruijn ctx le) s ctx)
     return [""]
act (EvalBind (s,le)) =
  do modify (\ctx -> MultiBimap.insert (simplifyAll $ toBruijn ctx le) s ctx)
     return [""]
act (Execute le) =
  do context <- get
     return [unlines $
             [ show le ] ++
             [ unlines $ map showReduction $ simplifySteps $ toBruijn context le ] ++
             [ showCompleteExp context $ simplifyAll $ toBruijn context le ]
            ]


-- TODO: Use Text instead of String for efficiency
-- | Executes multiple actions. Given a context and a set of actions, returns
-- the new context after the sequence of actions and a text output.
multipleAct :: [Action] -> State Context [String]
multipleAct actions = concat <$> mapM act actions



-- | Shows an expression and the name that is bound to the expression
-- in the current context
showCompleteExp :: Context -> Exp -> String
showCompleteExp context expr = case getExpressionName context expr of
  Nothing      -> show (nameExp expr)
  Just expName -> show (nameExp expr) ++ formatName ++ " ⇒ " ++ expName ++ end


-- | Given an expression, returns its name if it is bounded to any.
getExpressionName :: Context -> Exp -> Maybe String
getExpressionName context expr = case MultiBimap.lookup expr context of
  [] -> Nothing
  xs -> Just $ intercalate ", " xs




-- Parsing of interpreter command line commands.
-- | Parses an interpreter action.
interpreteractionParser :: Parser InterpreterAction
interpreteractionParser = choice
  [ try interpretParser
  , try quitParser
  , try loadParser
  , try verboseParser
  , try helpParser
  ]

-- | Parses a language action as an interpreter action.
interpretParser :: Parser InterpreterAction
interpretParser = Interpret <$> actionParser

-- | Parses a language action.
actionParser :: Parser Action
actionParser = choice
  [ try bindParser
  , try evalbindParser
  , try executeParser
  , try commentParser
  ]

-- | Parses a binding between a variable an its representation.
bindParser :: Parser Action
bindParser = fmap Bind $ (,) <$> many1 alphaNum <*> (spaces >> string "!=" >> spaces >> lambdaexp)

-- | Parses a binding and evaluation expression between a variable an its representation
evalbindParser :: Parser Action
evalbindParser = fmap EvalBind $ (,) <$> many1 alphaNum <*> (spaces >> string "=" >> spaces >> lambdaexp)

-- | Parses an expression in order to execute it.
executeParser :: Parser Action
executeParser = Execute <$> lambdaexp

-- | Parses comments.
commentParser :: Parser Action
commentParser = string "#" >> many anyChar >> return Comment

-- | Parses a "quit" command.
quitParser :: Parser InterpreterAction
quitParser = string ":quit" >> return Quit

-- | Parses a "help" command.
helpParser :: Parser InterpreterAction
helpParser = string ":help" >> return Help

-- | Parses a change in verbosity.
verboseParser :: Parser InterpreterAction
verboseParser = string ":verbose" >> return SetVerbose

-- | Parses a "load-file" command.
loadParser :: Parser InterpreterAction
loadParser = Load <$> (string ":load" >> between spaces spaces (many1 (satisfy (not . isSpace))))