diff --git a/src/Lish/Eval.hs b/src/Lish/Eval.hs index 98f17b3..e55f0be 100644 --- a/src/Lish/Eval.hs +++ b/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)) - _ -> lift (executeShell (Lambda reduced)) + Nothing -> 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,8 +71,8 @@ executeShell (Lambda args) = do _ -> Inherit case (map toS res) of (cmd:sargs) -> do - result <- trySh $ createProcess (proc cmd sargs) { std_in = stdinhandle - , std_out = CreatePipe } + result <- lift $ trySh $ createProcess (proc cmd sargs) { std_in = stdinhandle + , std_out = CreatePipe } case result of Right (_, mb_hout, _, _) -> return $ Stream mb_hout Left ex -> shellErr ("[shell 1/2] " <> (show (Lambda args)) <> "\n[shell 2/2] " <> show ex) diff --git a/src/Lish/InternalCommands.hs b/src/Lish/InternalCommands.hs index 0402caf..abc1da7 100644 --- a/src/Lish/InternalCommands.hs +++ b/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 (Atom x) = return $ Just $ toS x +toArg :: SExp -> StateT Env IO (Maybe Text) +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 -llet ((Atom name):v:[]) = do +-- | Define a var +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)