tricu

A lazy functional language based on Tree Calculus
Log | Files | Refs | README | LICENSE

Context.hs (1555B)

      1 {-# LANGUAGE ScopedTypeVariables #-}
      2 -- Read-only host context; no global cwd/environment mutation or implicit state.
      3 module IO.Context (workingDirectory, environmentVariable, boundedText) where
      4 import qualified IO.Resources as R
      5 import Control.Exception
      6 import qualified System.Directory as D
      7 import qualified System.Environment as E
      8 
      9 -- Bound the returned text; the host library may materialize it before this check.
     10 boundedText :: String -> String -> Either R.Problem String
     11 boundedText operation value
     12   | length (take 4097 value) > 4096 = Left (R.Problem "invalid-bound" operation "host context text exceeds scalar limit" "none")
     13   | any (\c -> c == '\0' || (c >= '\xD800' && c <= '\xDFFF')) value =
     14       Left (R.Problem "invalid-data" operation "host context is not NUL-free Unicode scalar text" "none")
     15   | otherwise = Right value
     16 
     17 workingDirectory :: IO (Either R.Problem FilePath)
     18 workingDirectory = (boundedText "working-directory" <$> D.getCurrentDirectory)
     19   `catch` (\(e :: IOException) -> pure (Left (R.ioProblem "working-directory" e)))
     20 
     21 environmentVariable :: String -> IO (Either R.Problem (Maybe String))
     22 environmentVariable name = case boundedText "environment-variable" name of
     23   Left problem -> pure (Left problem)
     24   Right checked | null checked || '=' `elem` checked -> pure (Left (R.Problem "invalid-argument" "environment-variable" "" "none"))
     25   Right checked -> (E.lookupEnv checked >>= pure . traverse (boundedText "environment-variable"))
     26     `catch` (\(e :: IOException) -> pure (Left (R.ioProblem "environment-variable" e)))