Command.hs

module DDCI.Tetra.Command
        ( Command (..)
        , commands
        , readCommand
        , handleCommand)
where
import DDCI.Tetra.State
import DDCI.Tetra.Command.Help
import DDCI.Tetra.Command.Set
import DDCI.Tetra.Command.Parse
import DDCI.Tetra.Command.Desugar
import DDCI.Tetra.Command.Infer
import DDCI.Tetra.Command.ToCore
import DDC.Driver.Interface.Source
import DDC.Driver.Command.ToSalt       
import Control.Monad.Trans.Except
import Data.List
import System.IO
import qualified DDC.Build.Interface.Store      as Store


-- | Commands accepted by ddci-tetra.
data Command
        = CommandBlank          -- ^ No command was entered.
        | CommandUnknown        -- ^ Some unknown (invalid) command.
        | CommandHelp           -- ^ Display the interpreter help.
        | CommandSet            -- ^ Set an interpreter mode.
        | CommandParse          -- ^ Parse a Tetra source module.
        | CommandDesugar        -- ^ Desugar a Tetra source module.
        | CommandInfer          -- ^ Perform type inference.
        | CommandToCore         -- ^ Convert to Core Tetra.
        | CommandToSalt         -- ^ Convert to Core Salt.
        deriving (Eq, Show)


-- | Names used to invoke each command.
commands :: [(String, Command)]
commands
 =      [ (":help",     CommandHelp)
        , (":?",        CommandHelp) 
        , (":set",      CommandSet)
        , (":parse",    CommandParse) 
        , (":desugar",  CommandDesugar)
        , (":infer",    CommandInfer) 
        , (":to-core",  CommandToCore) 
        , (":to-salt",  CommandToSalt) ]


-- | Read the command from the front of a string.
readCommand :: String -> Maybe (Command, String)
readCommand ss
        | null $ words ss
        = Just (CommandBlank,   ss)

        | (cmd, rest) : _ 
                <- [ (cmd, drop (length str) ss) 
                        | (str, cmd)      <- commands
                        , isPrefixOf str ss ]
        = Just (cmd, rest)

        | ':' : _  <- ss
        = Just (CommandUnknown, ss)

        | otherwise
        = Nothing


handleCommand :: State -> Command -> Source -> String -> IO State
handleCommand state cmd source line
 = do   state'  <- handleCommand1 state cmd source line
        return state'

handleCommand1 state cmd source line
 = case cmd of
        CommandBlank
         -> return state

        CommandUnknown
         -> do  putStr $ unlines
                 [ "unknown command."
                 , "use :? for help." ]

                return state

        CommandHelp
         -> do  putStrLn help
                return state

        CommandSet
         -> do  state'  <- cmdSet state line
                return state'

        CommandParse
         -> do  cmdParse state source line
                return state

        CommandDesugar
         -> do  cmdDesugar state source line
                return state

        CommandInfer
         -> do  cmdInfer state source line
                return state

        CommandToCore
         -> do  config  <- getDriverConfigOfState state
                store   <- Store.new
                cmdToCore state config store source line
                return state

        CommandToSalt
         -> do  config  <- getDriverConfigOfState state
                store   <- Store.new
                runError $ cmdToSaltSourceTetraFromString config store source line
                return state


-- | Just print errors to stdout and continue the session.
runError :: ExceptT String IO () -> IO ()
runError m
 = do   result  <- runExceptT m
        case result of
         Left err       -> hPutStrLn stdout err
         Right _        -> return ()