{-# LANGUAGE FlexibleContexts #-}
{-| Types used by the compiler infrastructure-}
module Database.Ferry.Compiler.Types where
    
import Control.Monad.Error
import Control.Monad.Writer
import Control.Monad.Reader

import Database.Ferry.Compiler.Error.Error

-- | The config datatype is used to store program flags given by the user 
--   The compiler can be put in a 'Mode' that determines what sort of
--   result the compilation process will result in.
--   The 'Input' element is set to specify whether a file should be compiled or 
--   input from the stdin
--   The debug component is set to switch on debugging mode, debugging mode
--   results in log information on the stdin and possibly extra compiler artifacts.
data Config = Config {
              mode :: Mode,
              logFile :: Maybe String,
              output :: Maybe String,
              input :: Input,
              artefact :: [Artefact],
              debug :: Bool
            }
            deriving Show

-- | The modes that are supported by the compiler.
--   run ferryc -h to see a list of all options
data Mode = Read
          | Parse  -- ^ Parse mode will stop the compiler after the parsing phase
          | Normalise 
          | Transform
          | TypeInfer
          | OpRewrite
          | Boxing
          | Algebra
          | AlgebraXML
    deriving (Show, Eq)
          
data Artefact = Echo   -- ^ Echo mode prints the given input to the console
              | PrettyAST -- ^ Pretty mode parses the given input and pretty prints the result
              | PrettyNormalAST
              | PrettyCore
              | DotAST
              | DotCore
              | DotType
              | DotRewrite
              | DotBox
              | DotAlg
              | XML
              | Type
    deriving (Show, Eq)

-- All possible artefacts
allArtefacts :: [Artefact]
allArtefacts = [Echo, PrettyAST, PrettyCore, DotAST, DotCore, DotType, DotBox, DotAlg, XML]

-- | The input mode determines whether the source program is given through a file or via stdin
data Input  = File String-- ^ File mode, the program is read from a file 
            | Arg  -- ^ Argument mode, the program is given as input directly
    deriving (Show, Eq)

-- | The default configuration for the compiler
defaultConfig :: Config
defaultConfig = Config {
                --  Standard 'Mode' is set to Full
                mode        = AlgebraXML,
                logFile     = Nothing,
                output      = Nothing, 
                --  By default the program is given through a File
                input       = Arg,
                -- Standard output is the empty list, denoting regular compilation proces
                artefact    = [XML], 
                --  Debug turned of by default
                debug       = False 
              }

-- | The results of artefact generation are all collected in a reader monad
-- The final result is written to disk or screen when compilation has succeeded
type ArtefactResult = Reader Config String

-- | Result of a compilation phase.
-- The error monad is used in case something went wrong during compilation
-- The first writer monad is used for logging purposes.
-- The second writer monad is used to store the artefacts generated by the compiler
-- And the reader monad stores the compiler configuration              
type PhaseResult r = ErrorT FerryError (WriterT Log (WriterT [File] (Reader Config))) r

-- | Name of an artefact file
type FileName = String

-- | Artefact file, the first element represents the output file, in case of nothing output is given
-- on stdout. The second component is the file content.
type File = (Maybe FileName, String)

-- | Compilationstep datatype.
-- A compilation step is a record containg a description (stageName field),
-- the internal mode name (stageMode field),
-- the actual stage computation (stageStep field) that transforms element of type a into a PhaseResult of type b
-- and stage artefact generators, a list of function generating artefacts (stageArtefacts field).
data CompilationStep a b  = CompilationStep { 
                                stageName :: Name, 
                                stageMode :: Mode,
                                stageStep :: a -> PhaseResult b,
                                stageArtefacts :: [(Artefact, String, b -> ArtefactResult)]
                                }

-- | Type synonym for a stage name type
type Name = String

-- | Every stage has a stage number
type Stage = Int

-- | The compilation log is just a string
type Log = [String]

-- | Lift the result of generating an artefact into the overall phase result type
artefactToPhaseResult :: ArtefactResult -> PhaseResult String
artefactToPhaseResult r = lift $ lift $ lift r

-- | Get the compiler configuration
getConfig :: PhaseResult Config
getConfig = ask

-- | Get the current log from a phaseresult
getLog :: Config -> PhaseResult r -> Log
getLog c n = (\(_, l, _) -> l) $ runPhase c n

-- | Get the artefacts from the phaseresult            
getFiles :: Config -> PhaseResult r -> [File]
getFiles c n = (\(_, _, f) -> f) $ runPhase c n        

-- | Execute a phaseresult under a given configuration,, resulting in triple of:
-- 1.) An error or the result
-- 2.) The compilation log
-- 3.) The generated artefacts
runPhase :: Config -> PhaseResult r -> (Either FerryError r, Log, [File])
runPhase c n = (\((r, l), f) -> (r, l, f)) $ flip runReader c $ runWriterT $ runWriterT $ runErrorT n

-- | Throw an error
newError :: FerryError -> PhaseResult r
newError e = ErrorT $ return $ Left e

-- | Final log message when end of compilation is reached
endProcess :: PhaseResult b
endProcess = do
                logMsg line
                logMsg "Reached compilation target"
                logMsg "Quiting compilation"
                logMsg line
                newError ProcessComplete

-- | Seperator line for logging
line :: String
line = "--------------------------------------------------"

-- | Log the message t
logMsg :: (MonadWriter [t] m) => t -> m ()
logMsg s = tell [s]

-- | Add the given file with contents to the phaseresult.
addFile :: Maybe FileName -> String -> PhaseResult ()
addFile n c = lift $ lift $ tell [(n, c)]