better behavior for def/set

src/Lish/Eval.hs

@@ -30,8 +30,8 @@ reduceLambda (Lambda exprs) = do
           resultEnv <- tryEnvCommand f args
           case resultEnv of
             Just x  -> return x
-            Nothing -> lift (executeShell (Lambda reduced))
+            Nothing -> executeShell (Lambda reduced)
-    _             ->  lift (executeShell (Lambda reduced))
+    _             ->  executeShell (Lambda reduced)
 reduceLambda x          = return x
 
 apply :: SExp -> Command
@@ -56,13 +56,13 @@ toStdIn :: SExp -> Maybe Handle
 toStdIn (WaitingStream h) = h
 toStdIn _                 = Nothing
 
-shellErr :: Text -> IO SExp
+shellErr :: Text -> StateT Env IO SExp
 shellErr errmsg = do
   putText ("Error: " <> errmsg)
   return Void
 
 -- | Execute a shell command
-executeShell :: SExp -> IO SExp
+executeShell :: SExp -> StateT Env IO SExp
 executeShell (Lambda args) = do
   res <- (mapM toArg args) >>= return . catMaybes
   let argsHandle = (filter isJust (map toStdIn args))
@@ -71,7 +71,7 @@ executeShell (Lambda args) = do
                       _          -> Inherit
   case (map toS res) of
     (cmd:sargs) -> do
-      result <- trySh $ createProcess (proc cmd sargs) { std_in = stdinhandle
+      result <- lift $ trySh $ createProcess (proc cmd sargs) { std_in = stdinhandle
                                                               , std_out = CreatePipe }
       case result of
         Right (_, mb_hout, _, _) -> return $ Stream mb_hout

src/Lish/InternalCommands.hs

@@ -14,21 +14,27 @@ import           Lish.Types
 import           Protolude          hiding (show)
 import           System.Environment (setEnv)
 
-toArg :: SExp -> IO (Maybe Text)
+toArg :: SExp -> StateT Env IO (Maybe Text)
-toArg (Atom x)          = return $ Just $ toS x
+toArg (Atom x)          = do
+  env <- get
+  return $ Just $ case Map.lookup x env of
+    Just (Str s) -> s
+    _ -> toS x
 toArg (Str s)           = return $ Just $ toS s
-toArg (Stream (Just h)) = fmap (Just . Text.strip .toS) (hGetContents h)
+toArg (Stream (Just h)) = lift $ fmap (Just . Text.strip .toS) (hGetContents h)
 toArg _                 = return $ Nothing
 
+-- | Print with return line
 prn :: Command
 prn args = do
-  strs <- catMaybes <$> liftIO (mapM toArg args)
+  strs <- catMaybes <$> mapM toArg args
   putStrLn $ (Text.intercalate " " strs)
   return Void
 
+-- | Print
 pr :: Command
 pr args = do
-  strs <- catMaybes <$> liftIO (mapM toArg args)
+  strs <- catMaybes <$> mapM toArg args
   putStr (Text.intercalate " " strs)
   return Void
 
@@ -37,39 +43,52 @@ evalErr errmsg = do
   putText $ "EvalError: " <> errmsg
   return Void
 
-llet :: Command
+-- | Define a var
-llet ((Atom name):v:[]) = do
+def :: Command
+def ((Atom name):v:[]) = do
   modify (Map.insert name v)
   return v
-llet _ = return Void
+def _ = evalErr "def need 2 args, an atom and an S-Expr. Ex: (def foo \"foo\")"
 
+-- | Undefine a var
+undef :: Command
+undef ((Atom name):[]) = do
+  modify (Map.delete name)
+  return Void
+undef x = evalErr $ "undef wait an atom got" <> toS (show x)
+
+-- | Export a var as Environment variable
 export :: Command
 export ((Atom name):v@(Str s):[]) = do
   liftIO $ setEnv (toS name) (toS s)
   modify (Map.insert name v)
   return v
-export _ = return Void
+export _ = evalErr $ "eval need an atom and a string (eval foo \"foo\")"
 
+-- | retrieve the value of a var
 getenv :: Command
 getenv ((Atom varname):[]) = do
   hm <- get
   return $ fromMaybe Void (Map.lookup varname hm)
-getenv _ = return Void
+getenv _ = evalErr "getenv need on atom as argument"
 
+-- | replace à la `sed s/old/new/g text`
 replace :: Command
 replace ((Str old) : (Str new) : (Str text) : []) =
   return $ Str $ Text.replace old new text
 replace _ = evalErr "replace should take 3 String arguments"
 
+-- | create a string and concat multiple elements
 str :: Command
 str exprs = do
-  args <- catMaybes <$> liftIO (mapM toArg exprs)
+  args <- catMaybes <$> mapM toArg exprs
   return $ Str $ Text.concat args
 
+-- | create an atom from a string (do nothing to atoms)
 atom :: Command
 atom ((Atom a):[]) = return $ Atom a
 atom ((Str s):[])  = return $ Atom s
-atom _             = return Void
+atom _             = evalErr "atom need an atom or a string"
 
 toWaitingStream :: Command
 toWaitingStream (Stream (Just h) :[]) = return (WaitingStream (Just h))
@@ -80,7 +99,8 @@ internalCommands = [ ("prn", prn)
                    , ("pr", pr)
                    , (">", toWaitingStream)
                    , ("replace", replace)
-                   , ("let",llet)
+                   , ("def",def)
+                   , ("undef",undef)
                    , ("export",export)
                    , ("getenv",getenv)
                    , ("$",getenv)