added environment

lish.cabal

@@ -30,6 +30,7 @@ library
   hs-source-dirs:    src
   exposed-modules:   Lib
                    , Lish.Core
+                   , Lish.Eval
                    , Lish.InternalCommands
                    , Lish.Parser
                    , Lish.Types

src/Lish/Core.hs

@@ -6,17 +6,14 @@ module Lish.Core
     runLish
   ) where
 
-import qualified Control.Exception        as Exception
-import           Data.Maybe               (catMaybes, isJust)
-import           GHC.IO.Handle            (Handle, hGetContents)
+import           GHC.IO.Handle            (hGetContents)
 import           Pipes
-import           Prelude                  (String, lines, lookup)
+import           Prelude                  (lines)
 import           Protolude                hiding (for, many, show, (<|>))
 import           System.Console.Haskeline
-import           System.Process
 import           Text.Parsec              (ParseError)
 
-import           Lish.InternalCommands
+import           Lish.Eval
 import           Lish.Parser
 import           Lish.Types
 
@@ -36,41 +33,6 @@ mainLoop = do
       eval (parseCmd ("(" <> line <> ")"))
       mainLoop
 
-toStdIn :: SExp -> Maybe Handle
-toStdIn (WaitingStream h) = h
-toStdIn _                 = Nothing
-
-shellErr :: String -> IO SExp
-shellErr errmsg = do
-  putStrLn ("Error: " <> errmsg)
-  return Void
-
-executeShell :: SExp -> IO SExp
-executeShell (Lambda args) = do
-  res <- (mapM toArg args) >>= return . catMaybes
-  let argsHandle = (filter isJust (map toStdIn args))
-      stdinhandle = case argsHandle of
-                      (Just h:_) -> UseHandle h
-                      _          -> Inherit
-  case (map toS res) of
-    (cmd:sargs) -> do
-      result <- 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)
-    _ -> shellErr "empty lambda!"
-  where
-    trySh :: IO a -> IO (Either IOException a)
-    trySh = Exception.try
-executeShell _ = shellErr "[shell] not a lambda!"
-
--- | Evaluate a command line
-eval :: Either ParseError SExp -> InputT IO ()
-eval parsed = case parsed of
-  Right sexp -> liftIO (reduceLambda sexp >>= evalReduced)
-  Left err   -> outputStrLn (show err)
-
 evalReduced :: SExp -> IO ()
 evalReduced Void = return ()
 evalReduced (Stream Nothing) = return ()
@@ -87,12 +49,7 @@ evalReduced (WaitingStream (Just h)) = do
   runEffect (for producer (lift . putStrLn))
 evalReduced x = putStrLn (show x)
 
-reduceLambda :: SExp -> IO SExp
-reduceLambda (Lambda exprs) = do
-  reduced <- mapM reduceLambda exprs
-  case reduced of
-    (Atom f:args) -> case lookup f internalCommands of
-                        Just fn -> fn args
-                        _       -> executeShell (Lambda reduced)
-    _             ->  executeShell (Lambda reduced)
-reduceLambda x          = return x
+eval :: Either ParseError SExp -> InputT IO ()
+eval parsed = case parsed of
+  Right sexpr -> liftIO (reduceLambda (EnvSExp sexpr []) >>= evalReduced .sexp)
+  Left err   -> outputStrLn (show err)

src/Lish/Eval.hs

@@ -0,0 +1,62 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- | Lish parser
+module Lish.Eval
+  ( reduceLambda
+  )
+  where
+
+import qualified Control.Exception        as Exception
+import           Protolude
+import           System.Process hiding (env)
+import           Prelude                  (lookup)
+
+import           Lish.Types hiding (show)
+import Lish.InternalCommands
+
+-- | The main evaluation function
+-- TODO: its real type should be something isomorphic to
+-- (SExp,Environment) -> IO (SExp, Environment)
+reduceLambda :: EnvSExp -> IO EnvSExp
+reduceLambda (EnvSExp { sexp = (Lambda exprs)
+                      , env = environment
+                      }) = do
+  reduced <- mapM reduceLambda (map (\sexpr -> EnvSExp sexpr environment) exprs)
+  case reduced of
+    (EnvSExp { sexp = Atom f, env = cmdenv}:args)
+      -> case lookup f internalCommands of
+           Just fn -> fn args
+           _       -> executeShell (Lambda (map sexp reduced)) >>= \s -> return $ EnvSExp { sexp = s, env = cmdenv }
+    _ ->  executeShell (Lambda (map sexp reduced)) >>= \s -> return $ EnvSExp { sexp = s, env = environment }
+reduceLambda x          = return x
+
+-- | take a SExp
+toStdIn :: SExp -> Maybe Handle
+toStdIn (WaitingStream h) = h
+toStdIn _                 = Nothing
+
+shellErr :: Text -> IO SExp
+shellErr errmsg = do
+  putText ("Error: " <> errmsg)
+  return Void
+
+-- | Execute a shell command
+executeShell :: SExp -> IO SExp
+executeShell (Lambda args) = do
+  res <- (mapM toArg args) >>= return . catMaybes
+  let argsHandle = (filter isJust (map toStdIn args))
+      stdinhandle = case argsHandle of
+                      (Just h:_) -> UseHandle h
+                      _          -> Inherit
+  case (map toS res) of
+    (cmd:sargs) -> do
+      result <- 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)
+    _ -> shellErr "empty lambda!"
+  where
+    trySh :: IO a -> IO (Either IOException a)
+    trySh = Exception.try
+executeShell _ = shellErr "[shell] not a lambda!"

src/Lish/InternalCommands.hs

@@ -20,29 +20,39 @@ toArg _                 = return $ Nothing
 
 prn :: Command
 prn args = do
-  strs <- catMaybes <$> (mapM toArg args)
-  putText (Text.intercalate " " strs)
-  return Void
+  strs <- catMaybes <$> (mapM (toArg . sexp) args)
+  putText $ (Text.intercalate " " strs) <> "\n"
+  return EnvSExp { sexp = Void
+                 , env = (mconcat (map env args))
+                 }
 
 pr :: Command
 pr args = do
-  strs <- catMaybes <$> (mapM toArg args)
+  strs <- catMaybes <$> (mapM (toArg . sexp) args)
   putText (Text.intercalate " " strs)
-  return Void
+  return EnvSExp { sexp = Void
+                 , env = (mconcat (map env args))
+                 }
 
-evalErr :: Text -> IO SExp
+evalErr :: Text -> IO EnvSExp
 evalErr errmsg = do
   putText $ "EvalError: " <> errmsg
-  return Void
+  return (EnvSExp Void empty)
 
 replace :: Command
-replace ((Str old):(Str new):(Str str):[]) =
-  return . Str $ Text.replace old new str
+replace args@((EnvSExp { sexp = (Str old)}) :
+              (EnvSExp { sexp = (Str new)}) :
+              (EnvSExp { sexp = (Str str)}) :
+              []) =
+  return $ EnvSExp { sexp =  Str $ Text.replace old new str
+                   , env = (mconcat (map env args))}
 replace _ = evalErr "replace should take 3 String arguments"
 
 toWaitingStream :: Command
-toWaitingStream ((Stream (Just h)):[]) = return (WaitingStream (Just h))
-toWaitingStream _                      = return Void
+toWaitingStream (EnvSExp { sexp = Stream (Just h)
+                         , env = environment     }:[]) =
+  return $ EnvSExp (WaitingStream (Just h)) environment
+toWaitingStream _                      = return (EnvSExp Void empty)
 
 internalCommands :: [(Text,Command)]
 internalCommands = [ ("prn", prn)

src/Lish/Types.hs

@@ -3,6 +3,7 @@
 -- | Lish types
 module Lish.Types
   ( SExp(..)
+  , EnvSExp(..)
   , show
   , CmdStream
   , Command
@@ -36,5 +37,6 @@ repr (Stream _)        = "<stream>"
 repr (WaitingStream _) = "<w-stream>"
 
 type CmdStream = Maybe Handle
-
-type Command = [SExp] -> IO SExp
+type Env = [(Text,SExp)]
+data EnvSExp = EnvSExp { sexp :: SExp , env :: Env}
+type Command = [EnvSExp] -> IO EnvSExp