git.iko.soy/effectful
on master help sign in
Add Environment effect (#32)

* Added Environment effect * Use functions from exceptions package

commitda565578a04114b2a3b22a93431c6712e6c049f6 authorMann mit Hut <mmhat@users.noreply.github.com> dateSun 3 Oct 2021, 15:12 (5 years ago) parent72764c9
5 files changed+138
compare with master
unifiedsplit
effectful/effectful.cabal+2 effectful/src/Effectful/Environment.hs+75 effectful/tests/EnvironmentTests.hs+42 effectful/tests/Main.hs+2 effectful/tests/Utils.hs+17
effectful/effectful.cabal+2
@@ -73,6 +73,7 @@ library
7373
7474 exposed-modules: Effectful
7575 Effectful.Async
76+ Effectful.Environment
7677 Effectful.Process
7778 Effectful.Resource
7879 Effectful.Temporary
@@ -113,6 +114,7 @@ test-suite test
113114
114115 other-modules: AsyncTests
115116 ConcurrencyTests
117+ EnvironmentTests
116118 ErrorTests
117119 StateTests
118120 Utils
effectful/src/Effectful/Environment.hsnew file+75
@@ -0,0 +1,75 @@
1+module Effectful.Environment
2+ ( -- * Environment effect
3+ Environment
4+ , runEnvironment
5+
6+ -- * Querying the environment
7+ , getArgs
8+ , getProgName
9+ , getExecutablePath
10+ , getEnv
11+ , getEnvironment
12+ , lookupEnv
13+
14+ -- * Modifying the environment
15+ , setEnv
16+ , unsetEnv
17+ , withArgs
18+ , withProgName
19+ ) where
20+
21+import qualified System.Environment as E
22+
23+import Effectful.Internal.Effect
24+import Effectful.Internal.Monad
25+
26+-- | An effect for querying and modifying the system environment.
27+data Environment :: Effect where
28+ Environment :: Environment m r
29+
30+runEnvironment :: IOE :> es => Eff (Environment : es) a -> Eff es a
31+runEnvironment = evalEffect (IdE Environment)
32+
33+-- | Lifted 'E.getArgs'.
34+getArgs :: Environment :> es => Eff es [String]
35+getArgs = unsafeEff_ E.getArgs
36+
37+-- | Lifted 'E.getEnv'.
38+getEnv :: Environment :> es => String -> Eff es String
39+getEnv = unsafeEff_ . E.getEnv
40+
41+-- | Lifted 'E.getEnvironment'.
42+getEnvironment :: Environment :> es => Eff es [(String, String)]
43+getEnvironment = unsafeEff_ E.getEnvironment
44+
45+-- | Lifted 'E.getExecutablePath'.
46+getExecutablePath :: Environment :> es => Eff es FilePath
47+getExecutablePath = unsafeEff_ E.getExecutablePath
48+
49+-- | Lifted 'E.getProgName'.
50+getProgName :: Environment :> es => Eff es String
51+getProgName = unsafeEff_ E.getProgName
52+
53+-- | Lifted 'E.lookupEnv'.
54+lookupEnv :: Environment :> es => String -> Eff es (Maybe String)
55+lookupEnv = unsafeEff_ . E.lookupEnv
56+
57+-- | Lifted 'E.setEnv'.
58+setEnv :: Environment :> es => String -> String -> Eff es ()
59+setEnv n = unsafeEff_ . E.setEnv n
60+
61+-- | Lifted 'E.unsetEnv'.
62+unsetEnv :: Environment :> es => String -> Eff es ()
63+unsetEnv = unsafeEff_ . E.unsetEnv
64+
65+-- | Lifted 'E.withArgs'.
66+withArgs :: Environment :> es => [String] -> Eff es a -> Eff es a
67+withArgs env k = unsafeEff $ \es -> do
68+ seqUnliftEff es $ \runInIO -> do
69+ E.withArgs env (runInIO k)
70+
71+-- | Lifted 'E.withProgName'.
72+withProgName :: Environment :> es => String -> Eff es a -> Eff es a
73+withProgName n k = unsafeEff $ \es -> do
74+ seqUnliftEff es $ \runInIO -> do
75+ E.withProgName n (runInIO k)
effectful/tests/EnvironmentTests.hsnew file+42
@@ -0,0 +1,42 @@
1+module EnvironmentTests (environmentTests) where
2+
3+import Test.Tasty
4+import Test.Tasty.HUnit
5+import System.IO.Error (isDoesNotExistError)
6+
7+import Effectful
8+import Effectful.Environment
9+import qualified Utils as U
10+
11+environmentTests :: TestTree
12+environmentTests = testGroup "Environment"
13+ [ testCase "set and get an environment variable" test_setAndGet
14+ , testCase "unset and try to get an environment variable" test_unsetAndGet
15+ , testCase "execute effects with custom arguments" test_withArgs
16+ , testCase "execute effects with custom program name" test_withProg
17+ ]
18+
19+test_setAndGet :: Assertion
20+test_setAndGet = runEff . runEnvironment $ do
21+ let n = "EFFECTFUL_TEST1"
22+ setEnv n "value"
23+ v <- getEnv n
24+ U.assertEqual "environment variable not set" v "value"
25+
26+test_unsetAndGet :: Assertion
27+test_unsetAndGet = runEff . runEnvironment $ do
28+ let n = "EFFECTFUL_TEST2"
29+ unsetEnv n
30+ U.assertThrows "environment variable is set" isDoesNotExistError (getEnv n)
31+
32+test_withArgs :: Assertion
33+test_withArgs = runEff . runEnvironment $ do
34+ let expected = ["effectful-test"]
35+ args <- withArgs expected getArgs
36+ U.assertEqual "correct arguments" args expected
37+
38+test_withProg :: Assertion
39+test_withProg = runEff . runEnvironment $ do
40+ let expected = "effectful-test"
41+ n <- withProgName expected getProgName
42+ U.assertEqual "correct program name" n expected
effectful/tests/Main.hs+2
@@ -4,6 +4,7 @@ import Test.Tasty
44
55import AsyncTests
66import ConcurrencyTests
7+import EnvironmentTests
78import ErrorTests
89import StateTests
910
@@ -11,6 +12,7 @@ main :: IO ()
1112main = defaultMain $ testGroup "effectful"
1213 [ asyncTests
1314 , concurrencyTests
15+ , environmentTests
1416 , errorTests
1517 , stateTests
1618 ]
effectful/tests/Utils.hs+17
@@ -2,10 +2,12 @@ module Utils
22 ( assertBool
33 , assertEqual
44 , assertFailure
5+ , assertThrows
56 , Ex(..)
67 ) where
78
89import Control.Exception
10+import Control.Monad
911import GHC.Stack
1012import qualified Test.Tasty.HUnit as T
1113
@@ -25,5 +27,20 @@ assertEqual msg expected given = liftIO $ T.assertEqual msg expected given
2527assertFailure :: (HasCallStack, IOE :> es) => String -> Eff es a
2628assertFailure msg = liftIO $ T.assertFailure msg
2729
30+assertThrows
31+ :: (Exception e, IOE :> es)
32+ => String
33+ -> (e -> Bool)
34+ -> Eff es a
35+ -> Eff es ()
36+assertThrows msg p k = withEffToIO $ \runInIO -> do
37+ let k' = do
38+ void $ runInIO k
39+ T.assertFailure msg
40+
41+ k' `catch` \e -> if p e
42+ then return ()
43+ else throwIO e
44+
2845data Ex = Ex deriving (Eq, Show)
2946instance Exception Ex