better behavior for def/set

This commit is contained in:
Yann Esposito (Yogsototh) 2017-02-25 20:43:35 +01:00
parent 9aa2627e2a
commit bd36b02931
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646
2 changed files with 39 additions and 19 deletions

View file

@ -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)

View file

@ -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)