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
|
resultEnv <- tryEnvCommand f args
|
||||||
case resultEnv of
|
case resultEnv of
|
||||||
Just x -> return x
|
Just x -> return x
|
||||||
Nothing -> lift (executeShell (Lambda reduced))
|
Nothing -> executeShell (Lambda reduced)
|
||||||
_ -> lift (executeShell (Lambda reduced))
|
_ -> executeShell (Lambda reduced)
|
||||||
reduceLambda x = return x
|
reduceLambda x = return x
|
||||||
|
|
||||||
apply :: SExp -> Command
|
apply :: SExp -> Command
|
||||||
|
@ -56,13 +56,13 @@ toStdIn :: SExp -> Maybe Handle
|
||||||
toStdIn (WaitingStream h) = h
|
toStdIn (WaitingStream h) = h
|
||||||
toStdIn _ = Nothing
|
toStdIn _ = Nothing
|
||||||
|
|
||||||
shellErr :: Text -> IO SExp
|
shellErr :: Text -> StateT Env IO SExp
|
||||||
shellErr errmsg = do
|
shellErr errmsg = do
|
||||||
putText ("Error: " <> errmsg)
|
putText ("Error: " <> errmsg)
|
||||||
return Void
|
return Void
|
||||||
|
|
||||||
-- | Execute a shell command
|
-- | Execute a shell command
|
||||||
executeShell :: SExp -> IO SExp
|
executeShell :: SExp -> StateT Env IO SExp
|
||||||
executeShell (Lambda args) = do
|
executeShell (Lambda args) = do
|
||||||
res <- (mapM toArg args) >>= return . catMaybes
|
res <- (mapM toArg args) >>= return . catMaybes
|
||||||
let argsHandle = (filter isJust (map toStdIn args))
|
let argsHandle = (filter isJust (map toStdIn args))
|
||||||
|
@ -71,8 +71,8 @@ executeShell (Lambda args) = do
|
||||||
_ -> Inherit
|
_ -> Inherit
|
||||||
case (map toS res) of
|
case (map toS res) of
|
||||||
(cmd:sargs) -> do
|
(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 }
|
, std_out = CreatePipe }
|
||||||
case result of
|
case result of
|
||||||
Right (_, mb_hout, _, _) -> return $ Stream mb_hout
|
Right (_, mb_hout, _, _) -> return $ Stream mb_hout
|
||||||
Left ex -> shellErr ("[shell 1/2] " <> (show (Lambda args)) <> "\n[shell 2/2] " <> show ex)
|
Left ex -> shellErr ("[shell 1/2] " <> (show (Lambda args)) <> "\n[shell 2/2] " <> show ex)
|
||||||
|
|
|
@ -14,21 +14,27 @@ import Lish.Types
|
||||||
import Protolude hiding (show)
|
import Protolude hiding (show)
|
||||||
import System.Environment (setEnv)
|
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 (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
|
toArg _ = return $ Nothing
|
||||||
|
|
||||||
|
-- | Print with return line
|
||||||
prn :: Command
|
prn :: Command
|
||||||
prn args = do
|
prn args = do
|
||||||
strs <- catMaybes <$> liftIO (mapM toArg args)
|
strs <- catMaybes <$> mapM toArg args
|
||||||
putStrLn $ (Text.intercalate " " strs)
|
putStrLn $ (Text.intercalate " " strs)
|
||||||
return Void
|
return Void
|
||||||
|
|
||||||
|
-- | Print
|
||||||
pr :: Command
|
pr :: Command
|
||||||
pr args = do
|
pr args = do
|
||||||
strs <- catMaybes <$> liftIO (mapM toArg args)
|
strs <- catMaybes <$> mapM toArg args
|
||||||
putStr (Text.intercalate " " strs)
|
putStr (Text.intercalate " " strs)
|
||||||
return Void
|
return Void
|
||||||
|
|
||||||
|
@ -37,39 +43,52 @@ evalErr errmsg = do
|
||||||
putText $ "EvalError: " <> errmsg
|
putText $ "EvalError: " <> errmsg
|
||||||
return Void
|
return Void
|
||||||
|
|
||||||
llet :: Command
|
-- | Define a var
|
||||||
llet ((Atom name):v:[]) = do
|
def :: Command
|
||||||
|
def ((Atom name):v:[]) = do
|
||||||
modify (Map.insert name v)
|
modify (Map.insert name v)
|
||||||
return 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 :: Command
|
||||||
export ((Atom name):v@(Str s):[]) = do
|
export ((Atom name):v@(Str s):[]) = do
|
||||||
liftIO $ setEnv (toS name) (toS s)
|
liftIO $ setEnv (toS name) (toS s)
|
||||||
modify (Map.insert name v)
|
modify (Map.insert name v)
|
||||||
return 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 :: Command
|
||||||
getenv ((Atom varname):[]) = do
|
getenv ((Atom varname):[]) = do
|
||||||
hm <- get
|
hm <- get
|
||||||
return $ fromMaybe Void (Map.lookup varname hm)
|
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 :: Command
|
||||||
replace ((Str old) : (Str new) : (Str text) : []) =
|
replace ((Str old) : (Str new) : (Str text) : []) =
|
||||||
return $ Str $ Text.replace old new text
|
return $ Str $ Text.replace old new text
|
||||||
replace _ = evalErr "replace should take 3 String arguments"
|
replace _ = evalErr "replace should take 3 String arguments"
|
||||||
|
|
||||||
|
-- | create a string and concat multiple elements
|
||||||
str :: Command
|
str :: Command
|
||||||
str exprs = do
|
str exprs = do
|
||||||
args <- catMaybes <$> liftIO (mapM toArg exprs)
|
args <- catMaybes <$> mapM toArg exprs
|
||||||
return $ Str $ Text.concat args
|
return $ Str $ Text.concat args
|
||||||
|
|
||||||
|
-- | create an atom from a string (do nothing to atoms)
|
||||||
atom :: Command
|
atom :: Command
|
||||||
atom ((Atom a):[]) = return $ Atom a
|
atom ((Atom a):[]) = return $ Atom a
|
||||||
atom ((Str s):[]) = return $ Atom s
|
atom ((Str s):[]) = return $ Atom s
|
||||||
atom _ = return Void
|
atom _ = evalErr "atom need an atom or a string"
|
||||||
|
|
||||||
toWaitingStream :: Command
|
toWaitingStream :: Command
|
||||||
toWaitingStream (Stream (Just h) :[]) = return (WaitingStream (Just h))
|
toWaitingStream (Stream (Just h) :[]) = return (WaitingStream (Just h))
|
||||||
|
@ -80,7 +99,8 @@ internalCommands = [ ("prn", prn)
|
||||||
, ("pr", pr)
|
, ("pr", pr)
|
||||||
, (">", toWaitingStream)
|
, (">", toWaitingStream)
|
||||||
, ("replace", replace)
|
, ("replace", replace)
|
||||||
, ("let",llet)
|
, ("def",def)
|
||||||
|
, ("undef",undef)
|
||||||
, ("export",export)
|
, ("export",export)
|
||||||
, ("getenv",getenv)
|
, ("getenv",getenv)
|
||||||
, ("$",getenv)
|
, ("$",getenv)
|
||||||
|
|
Loading…
Reference in a new issue