From 7ea89e03699b486e0384001ad83f814298a5101f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Erik=20Sved=C3=A4ng?= <erik.svedang@gmail.com>
Date: Thu, 30 Nov 2017 08:12:53 +0100
Subject: [PATCH] Expand command.

---
 app/Main.hs     |  1 +
 src/Commands.hs | 27 +++++++++++++++------------
 2 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 6078763b..453f6872 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -156,6 +156,7 @@ startingGlobalEnv noArray =
                                   , addCommand "project" (CommandFunction commandProject)
                                   , addCommand "load" (CommandFunction commandLoad)
                                   , addCommand "macro-log" (CommandFunction commandPrint)
+                                  , addCommand "expand" (CommandFunction commandExpand)
                                   ] ++ (if noArray then [] else [("Array", Binder (XObj (Mod arrayModule) Nothing Nothing))])
 
 startingTypeEnv :: Env
diff --git a/src/Commands.hs b/src/Commands.hs
index 27085532..33e9905e 100644
--- a/src/Commands.hs
+++ b/src/Commands.hs
@@ -35,7 +35,6 @@ data ReplCommand = Define XObj
                  | DefineDynamic String XObj XObj
                  | DefineAlias String XObj
                  | DefineInterface String XObj (Maybe Info)
-                 | Expand XObj
                  | Type XObj
                  | GetInfo XObj
                  | InstantiateTemplate XObj XObj
@@ -89,7 +88,6 @@ objToCommand ctx xobj =
                    [XObj (Sym (SymPath _ "defalias")) _ _, XObj (Sym (SymPath _ name)) _ _, t] ->return $  DefineAlias name t
                    [XObj (Sym (SymPath _ "definterface")) _ _, XObj (Sym (SymPath _ name)) _ _, t] ->return $  DefineInterface name t (info xobj)
                    [XObj (Sym (SymPath _ "eval")) _ _, form] ->return $  Eval form
-                   [XObj (Sym (SymPath _ "expand")) _ _, form] ->return $  Expand form
                    [XObj (Sym (SymPath _ "instantiate")) _ _, name, signature] ->return $  InstantiateTemplate name signature
                    [XObj (Sym (SymPath _ "type")) _ _, form] ->return $  Type form
                    [XObj (Sym (SymPath _ "info")) _ _, form] ->return $  GetInfo form
@@ -371,16 +369,6 @@ executeCommand ctx@(Context env typeEnv pathStrings proj lastInput execMode) cmd
                 do putStrLnWithColor Yellow ("=> " ++ (pretty evaled))
                    return newCtx
 
-       Expand xobj ->
-         do (result, newCtx) <- runStateT (expandAll env xobj) ctx
-            case result of
-              Left e ->
-                do putStrLnWithColor Red (show e)
-                   return newCtx
-              Right expanded ->
-                do putStrLnWithColor Yellow (pretty expanded)
-                   return newCtx
-
        Use path xobj ->
          let e = getEnv env pathStrings
              useThese = envUseModules e
@@ -743,3 +731,18 @@ commandPrint :: CommandCallback
 commandPrint args =
   do liftIO $ mapM_ (putStrLn . pretty) args
      return dynamicNil
+
+commandExpand :: CommandCallback
+commandExpand [xobj] =
+  do ctx <- get
+     result <-expandAll (contextGlobalEnv ctx) xobj
+     case result of
+       Left e ->
+         liftIO $ do putStrLnWithColor Red (show e)
+                     return dynamicNil
+       Right expanded ->
+         liftIO $ do putStrLnWithColor Yellow (pretty expanded)
+                     return dynamicNil
+commandExpand args =
+  liftIO $ do putStrLnWithColor Red ("Invalid args to 'commandExpand':" ++ joinWithComma (map pretty args))
+              return dynamicNil