Eval.hs

-- Disco.Interactive.Eval (no changes here)

handleCMD :: String -> Disco IErr ()
handleCMD "" = return ()
handleCMD s = do
    exts <- use enabledExts
    case (parseLine exts s) of
      Left msg -> io $ putStrLn msg
      Right l -> handleLine l `catchError` (io . print  {- XXX pretty-print error -})
  where
    handleLine :: REPLExpr -> Disco IErr ()

    handleLine (Using e)     = enabledExts %= addExtension e
    handleLine (Let x t)     = handleLet x t
    handleLine (TypeCheck t) = handleTypeCheck t        >>= iputStrLn
    handleLine (Eval t)      = evalTerm t
    handleLine (ShowDefn x)  = handleShowDefn x         >>= iputStrLn
    handleLine (Parse t)     = iprint $ t
    handleLine (Pretty t)    = renderDoc (prettyTerm t) >>= iputStrLn
    handleLine (Ann t)       = handleAnn t              >>= iputStrLn
    handleLine (Desugar t)   = handleDesugar t          >>= iputStrLn
    handleLine (Compile t)   = handleCompile t          >>= iputStrLn
    handleLine (Import m)    = handleImport m
    handleLine (Load file)   = handleLoad file >> lastFile .= Just file >>return ()
    handleLine (Reload)      = do
      file <- use lastFile
      case file of
        Nothing -> iputStrLn "No file to reload."
        Just f  -> handleLoad f >> return()
    handleLine (Doc x)       = handleDocs x
    handleLine Nop           = return ()
    handleLine Help          = handleHelp
    handleLine Names         = handleNames

Parser.hs

-- Disco.Interactive.Parser

data ReplCommandType =
    User
  | Dev
  | Advanced -- unusued, just a thought
  deriving Show

data ReplCommand = ReplCommand
  { name  :: String 
  , shortHelp :: String
  , longHelp :: String
  , cmdType :: ReplCommandType
  , cmdAction :: String -- I think what I want here is a `REPLExpr -> Disco IErr ()`
  , cmdParser :: Parser REPLExpr
  }

discoCommands :: [ReplCommand]
discoCommands = 
  [
  ReplCommand {
      name = "help",
      shortHelp = "Show help",
      longHelp = "Show help",
      cmdType = User,
      cmdAction = "foo",
      cmdParser = return Help
    },
    ReplCommand {
      name = "type",
      shortHelp = "Typecheck a term",
      longHelp = "Typecheck a term",
      cmdType = User,
      cmdAction = "foo", -- REPLExpr -> Disco IErr ()
      cmdParser = TypeCheck <$> parseTypeTarget
    },
    ReplCommand {
      name = "names",
      shortHelp = "Show all names in current scope",
      longHelp = "Show all names in current scope",
      cmdType = User,
      cmdAction = "foo",
      cmdParser = return Names
    },
    ReplCommand {
      name = "defn",
      shortHelp = "",
      longHelp = "",
      cmdType = User,
      cmdAction = "foo",
      cmdParser = ShowDefn  <$> (sc *> ident)
    }
  ]
  
  
parseCommandArgs :: String -> Parser REPLExpr
parseCommandArgs cmd = maybe badCmd snd $ find ((cmd `isPrefixOf`) . fst) parsers
  where
    badCmd = fail $ "Command \":" ++ cmd ++ "\" is unrecognized."
    parsers = map (\rc -> (name rc, cmdParser rc)) discoCommands