better behavior for def/set
This commit is contained in:
parent
9aa2627e2a
commit
bd36b02931
2 changed files with 39 additions and 19 deletions
|
@ -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,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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue