feat: add Dynamic.get-env and Dynamic.set-env (#1227)

src/Commands.hs

@@ -23,6 +23,7 @@ import Project
 import Reify
 import RenderDocs
 import System.Directory (makeAbsolute)
+import System.Environment (getEnv, setEnv)
 import System.Exit (ExitCode (..), exitSuccess)
 import System.IO (IOMode (..), hClose, hPutStr, hSetEncoding, openFile, utf8)
 import System.Info (arch, os)
@@ -705,6 +706,24 @@ commandWriteFile ctx filename contents =
         _ -> pure (evalError ctx ("The second argument to `write-file` must be a string, I got `" ++ pretty contents ++ "`") (xobjInfo contents))
     _ -> pure (evalError ctx ("The first argument to `write-file` must be a string, I got `" ++ pretty filename ++ "`") (xobjInfo filename))
 
+commandGetEnv :: UnaryCommandCallback
+commandGetEnv ctx (XObj (Str var) _ _) = do
+  exceptional <- liftIO ((try $ getEnv var) :: (IO (Either IOException String)))
+  pure $ case exceptional of
+    Right v -> (ctx, Right (XObj (Str v) (Just dummyInfo) (Just StringTy)))
+    Left _ -> (ctx, dynamicNil)
+commandGetEnv ctx notString =
+  pure (evalError ctx ("The argument to `get-env` must be a string, I got `" ++ pretty notString ++ "`") (xobjInfo notString))
+
+commandSetEnv :: BinaryCommandCallback
+commandSetEnv ctx (XObj (Str var) _ _) (XObj (Str val) _ _) = do
+  liftIO $ setEnv var val
+  pure (ctx, dynamicNil)
+commandSetEnv ctx notString (XObj (Str _) _ _) =
+  pure (evalError ctx ("The first argument to `set-env` must be a string, I got `" ++ pretty notString ++ "`") (xobjInfo notString))
+commandSetEnv ctx _ notString =
+  pure (evalError ctx ("The second argument to `set-env` must be a string, I got `" ++ pretty notString ++ "`") (xobjInfo notString))
+
 commandHostBitWidth :: NullaryCommandCallback
 commandHostBitWidth ctx =
   let bitSize = Integral (finiteBitSize (undefined :: Int))

src/StartingEnv.hs

@@ -259,6 +259,7 @@ dynamicModule =
             f "relative-include" commandAddRelativeInclude "adds a relative include, i.e. a C `include` with quotes. It also prepends the current directory." "(relative-include \"myheader.h\")",
             f "save-docs-internal" commandSaveDocsInternal "is the internal companion command to `save-docs`. `save-docs` should be called instead." "(save-docs-internal 'Module)",
             f "read-file" commandReadFile "reads a file into a string." "(read-file \"myfile.txt\")",
+            f "get-env" commandGetEnv "gets an environment variable. The result will be `()` if it isn’t set." "(read-file \"CARP_DIR\")",
             f "hash" commandHash "calculates the hash associated with a value." "(hash '('my 'value)) ; => 3175346968842793108",
             f "round" commandRound "rounds its numeric argument." "(round 2.4) ; => 2",
             f "dynamic-type" commandType "Gets the dynamic type as a string." "(dynamic-type '()) ; => \"list\""
@@ -275,7 +276,8 @@ dynamicModule =
             f "-" commandMinus "subtracts its second argument from its first." "(- 1 2) ; => -1",
             f "/" commandDiv "divides its first argument by its second." "(/ 4 2) ; => 2",
             f "*" commandMul "multiplies its two arguments." "(* 2 3) ; => 6",
-            f "write-file" commandWriteFile "writes a string to a file." "(write-file \"myfile\" \"hello there!\")"
+            f "write-file" commandWriteFile "writes a string to a file." "(write-file \"myfile\" \"hello there!\")",
+            f "set-env" commandSetEnv "sets an environment variable." "(set-env \"CARP_WAS_HERE\" \"true\")"
           ]
     variadics =
       let f = addVariadicCommand . spath