{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-incomplete-uni-patterns #-} {-# LANGUAGE OverloadedStrings #-} module Test.System.GPIO.Linux.Sysfs.SysfsGpioMockSpec (spec) where import Protolude hiding (handle) import Control.Monad.Catch (MonadCatch, MonadMask, handle) import qualified Data.Map.Strict as Map (lookup) import qualified Data.Set as Set (empty, fromList) import System.GPIO.Linux.Sysfs.Mock import System.GPIO.Linux.Sysfs.Types (SysfsEdge(..), SysfsException(..)) import System.GPIO.Monad import Test.Hspec -- To some extent, these tests only test the implementation of the -- Mock interpreter, which isn't particularly valuable on its own. -- However, it does allow us to test that we're able to express the -- kinds of GpioT programs we want, in a pure environment (and when -- the platform we're developing on doesn't actually have GPIO -- functionality). testOpenClose :: (MonadGpio h m) => m () testOpenClose = do h <- openPin (Pin 1) closePin h testSetInterruptMode :: (MonadGpio h m) => m (PinInterruptMode, PinInterruptMode, PinInterruptMode, PinInterruptMode) testSetInterruptMode = do d <- openPin (Pin 1) setPinInputMode d InputDefault setPinInterruptMode d Disabled t1 <- getPinInterruptMode d setPinInterruptMode d RisingEdge t2 <- getPinInterruptMode d setPinInterruptMode d FallingEdge t3 <- getPinInterruptMode d setPinInterruptMode d Level t4 <- getPinInterruptMode d closePin d return (t1, t2, t3, t4) testSetInterruptModeIdempotent :: (MonadGpio h m) => m (PinInterruptMode, PinInterruptMode) testSetInterruptModeIdempotent = do d <- openPin (Pin 1) setPinInputMode d InputDefault setPinInterruptMode d FallingEdge t1 <- getPinInterruptMode d setPinInterruptMode d FallingEdge t2 <- getPinInterruptMode d closePin d return (t1, t2) testReadWritePin :: (MonadGpio h m) => h -> m (PinValue, PinValue, PinValue) testReadWritePin d = do val1 <- readPin d case val1 of Low -> do writePin d High val2 <- readPin d writePin d Low val3 <- readPin d return (val1,val2,val3) High -> do writePin d Low val2 <- readPin d writePin d High val3 <- readPin d return (val1,val2,val3) testReadWritePinIdempotent :: (MonadGpio h m) => m (PinValue, PinValue) testReadWritePinIdempotent = do d <- openPin (Pin 1) setPinOutputMode d OutputDefault Low val1 <- readPin d case val1 of Low -> do writePin d Low val2 <- readPin d closePin d return (val1,val2) High -> do writePin d High val2 <- readPin d closePin d return (val1,val2) testWritePinFailsOnInputPin :: (MonadGpio h m) => m () testWritePinFailsOnInputPin = do d <- openPin (Pin 1) setPinInputMode d InputDefault writePin d High closePin d testTogglePinValue :: (MonadGpio h m) => m (PinValue, PinValue, PinValue, PinValue, PinValue) testTogglePinValue = do d <- openPin (Pin 1) setPinOutputMode d OutputDefault Low val1 <- readPin d val2 <- togglePin d val3 <- readPin d val4 <- togglePin d val5 <- readPin d closePin d return (val1, val2, val3, val4, val5) testTogglePinActiveLevel :: (MonadGpio h m) => h -> m (PinActiveLevel, PinActiveLevel, PinActiveLevel, PinActiveLevel, PinActiveLevel) testTogglePinActiveLevel h = do val1 <- getPinActiveLevel h val2 <- togglePinActiveLevel h val3 <- getPinActiveLevel h val4 <- togglePinActiveLevel h val5 <- getPinActiveLevel h return (val1, val2, val3, val4, val5) invalidHandle :: (MonadGpio h m) => (h -> m a) -> m a invalidHandle action = do d <- openPin (Pin 1) closePin d action d testWithPin :: (MonadGpio h m, MonadMask m) => m PinValue testWithPin = withPin (Pin 1) $ \h -> do setPinOutputMode h OutputDefault Low writePin h High val <- readPin h return val testNestedWithPin :: (MonadGpio h m, MonadMask m) => Pin -> Pin -> m (PinValue, PinValue) testNestedWithPin p1 p2 = withPin p1 $ \h1 -> withPin p2 $ \h2 -> do setPinOutputMode h1 OutputDefault Low setPinOutputMode h2 OutputDefault Low writePin h1 High writePin h2 Low val1 <- readPin h1 val2 <- readPin h2 return (val1, val2) handleGpioException :: MonadCatch m => (SomeGpioException -> m a) -> m a -> m a handleGpioException = handle testWithPinError :: (MonadGpio h m, MonadMask m, MonadCatch m) => Pin -> Pin -> m (Maybe PinValue) testWithPinError p1 p2 = handleGpioException (const $ return Nothing) $ withPin p1 $ \h1 -> withPin p2 $ \h2 -> do setPinOutputMode h1 OutputDefault Low setPinInputMode h2 InputDefault writePin h1 High -- should fail if p1 == p2 writePin h2 Low -- should fail in any case val1 <- readPin h1 return $ Just val1 chip0 :: MockGpioChip chip0 = MockGpioChip "chip0" 0 (replicate 16 defaultMockPinState) chip1 :: MockGpioChip chip1 = MockGpioChip "chip1" 32 (replicate 32 defaultMockPinState) evalSysfsGpioMock' :: SysfsGpioMock a -> MockWorld -> [MockGpioChip] -> Either (Maybe SysfsException) a evalSysfsGpioMock' a w c = either (Left . fromException) return $ evalSysfsGpioMock a w c execSysfsGpioMock' :: SysfsGpioMock a -> MockWorld -> [MockGpioChip] -> Either (Maybe SysfsException) MockWorld execSysfsGpioMock' a w c = either (Left . fromException) return $ execSysfsGpioMock a w c runSysfsGpioMock' :: SysfsGpioMock a -> MockWorld -> [MockGpioChip] -> Either (Maybe SysfsException) (a, MockWorld) runSysfsGpioMock' a w c = either (Left . fromException) return $ runSysfsGpioMock a w c evalSysfsMock' :: SysfsMock a -> MockWorld -> [MockGpioChip] -> Either (Maybe SysfsException) a evalSysfsMock' a w c = either (Left . fromException) Right $ evalSysfsMock a w c spec :: Spec spec = do describe "pins" $ let pinList = map Pin [0..15] expectedResult = Right pinList in it "returns the list of available pins" $ evalSysfsGpioMock' pins initialMockWorld [chip0] `shouldBe` expectedResult describe "pinCapabilities" $ do it "returns a pin's capabilities" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState ,defaultMockPinState {_userVisibleDirection = False} ,defaultMockPinState {_edge = Nothing}] (Right result) = evalSysfsGpioMock' (do c1 <- pinCapabilities (Pin 1) c2 <- pinCapabilities (Pin 2) c3 <- pinCapabilities (Pin 3) return (c1,c2,c3) ) initialMockWorld [testChip] in do result `shouldBe` (PinCapabilities (Set.fromList [InputDefault]) (Set.fromList [OutputDefault]) True, PinCapabilities Set.empty Set.empty False, PinCapabilities (Set.fromList [InputDefault]) (Set.fromList [OutputDefault]) False) it "doesn't leave any pin state around" $ let (Right world) = execSysfsGpioMock (void $ pinCapabilities (Pin 1)) initialMockWorld [chip0] in evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio1") world [] `shouldBe` Right False it "fails if the pin doesn't exist" $ let (Left failure) = evalSysfsGpioMock' (pinCapabilities (Pin 99)) initialMockWorld [chip0] in failure `shouldBe` (Just $ InvalidPin (Pin 99)) describe "openPin/closePin" $ do it "cleans up properly" $ let (Right world) = execSysfsGpioMock' testOpenClose initialMockWorld [chip0] in evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio1") world [] `shouldBe` Right False it "fails when the pin is unavailable" $ evalSysfsGpioMock' testOpenClose initialMockWorld [chip1] `shouldBe` Left (Just $ InvalidPin (Pin 1)) it "openPin does not error when the pin is already open" $ evalSysfsGpioMock' (openPin (Pin 1) >> openPin (Pin 1) >> return ()) initialMockWorld [chip0] `shouldBe` Right () it "closePin does not error when the pin is already closed" $ evalSysfsGpioMock' (do { h <- openPin (Pin 1) ; closePin h ; closePin h} ) initialMockWorld [chip0] `shouldBe` Right () describe "getPinDirection" $ do it "gets the pin's direction" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = In}] in do evalSysfsGpioMock' (withPin (Pin 1) getPinDirection) initialMockWorld [chip0] `shouldBe` Right Out evalSysfsGpioMock' (withPin (Pin 1) getPinDirection) initialMockWorld [testChip] `shouldBe` Right In it "fails when the pin direction is not settable" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_userVisibleDirection = False}] in evalSysfsGpioMock' (withPin (Pin 1) getPinDirection) initialMockWorld [testChip] `shouldBe` Left (Just $ NoDirectionAttribute (Pin 1)) describe "getPinInputMode" $ do it "gets the pin's input mode" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = In}] in evalSysfsGpioMock' (withPin (Pin 1) getPinInputMode) initialMockWorld [testChip] `shouldBe` Right InputDefault it "fails when the pin's direction is Out" $ evalSysfsGpioMock' (withPin (Pin 1) getPinInputMode) initialMockWorld [chip0] `shouldBe` Left (Just $ InvalidOperation (Pin 1)) describe "setPinInputMode" $ do it "sets the pin's input mode and direction" $ let testChip1 = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = Out, _edge = Just Falling, _activeLow = True}] testChip2 = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = In, _edge = Just Rising}] (Right (result1,world1)) = runSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinInputMode h InputDefault >> getPinInputMode h) initialMockWorld [testChip1] (Right (result2,world2)) = runSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinInputMode h InputDefault >> getPinInputMode h) initialMockWorld [testChip2] in do result1 `shouldBe` InputDefault result2 `shouldBe` InputDefault Map.lookup (Pin 1) (mockWorldPins world1) `shouldBe` Just (defaultMockPinState {_direction = In, _edge = Just Falling, _activeLow = True}) Map.lookup (Pin 1) (mockWorldPins world2) `shouldBe` Just (defaultMockPinState {_direction = In, _edge = Just Rising}) it "fails when the input mode is unsupported" $ evalSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinInputMode h InputFloating) initialMockWorld [chip0] `shouldBe` Left (Just $ (UnsupportedInputMode InputFloating (Pin 1))) it "fails when the pin's direction is not settable" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_userVisibleDirection = False}] in evalSysfsGpioMock' (withPin (Pin 1) (\h -> setPinInputMode h InputDefault)) initialMockWorld [testChip] `shouldBe` Left (Just $ NoDirectionAttribute (Pin 1)) describe "getPinOutputMode" $ do it "gets the pin's output mode" $ evalSysfsGpioMock' (withPin (Pin 1) getPinOutputMode) initialMockWorld [chip0] `shouldBe` Right OutputDefault it "fails when the pin's direction is Out" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = In}] in evalSysfsGpioMock' (withPin (Pin 1) getPinOutputMode) initialMockWorld [testChip] `shouldBe` Left (Just $ InvalidOperation (Pin 1)) describe "setPinOutputMode" $ do it "sets the pin's output mode, value, and direction" $ let testChip1 = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = In, _value = Low}] (Right (result1,world1)) = runSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinOutputMode h OutputDefault High >> getPinOutputMode h) initialMockWorld [testChip1] testChip2 = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = In, _value = Low}] (Right (result2,world2)) = runSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinOutputMode h OutputDefault Low >> getPinOutputMode h) initialMockWorld [testChip2] testChip3 = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = Out, _value = High}] (Right (result3,world3)) = runSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinOutputMode h OutputDefault Low >> getPinOutputMode h) initialMockWorld [testChip3] (Right (result4,world4)) = runSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinOutputMode h OutputDefault High >> getPinOutputMode h) initialMockWorld [chip0] in do result1 `shouldBe` OutputDefault result2 `shouldBe` OutputDefault result3 `shouldBe` OutputDefault result4 `shouldBe` OutputDefault Map.lookup (Pin 1) (mockWorldPins world1) `shouldBe` Just (defaultMockPinState {_direction = Out, _value = High}) Map.lookup (Pin 1) (mockWorldPins world2) `shouldBe` Just (defaultMockPinState {_direction = Out, _value = Low}) Map.lookup (Pin 1) (mockWorldPins world3) `shouldBe` Just (defaultMockPinState {_direction = Out, _value = Low}) Map.lookup (Pin 1) (mockWorldPins world4) `shouldBe` Just (defaultMockPinState {_direction = Out, _value = High}) it "respects the pin's active level" $ let testChip1 = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = In, _value = Low, _activeLow = True}] (Right (result1,world1)) = runSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinOutputMode h OutputDefault High >> getPinOutputMode h) initialMockWorld [testChip1] testChip2 = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = In, _value = Low, _activeLow = True}] (Right (result2,world2)) = runSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinOutputMode h OutputDefault Low >> getPinOutputMode h) initialMockWorld [testChip2] testChip3 = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = Out, _value = High, _activeLow = True}] (Right (result3,world3)) = runSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinOutputMode h OutputDefault Low >> getPinOutputMode h) initialMockWorld [testChip3] testChip4 = MockGpioChip "testChip" 1 [defaultMockPinState {_activeLow = True}] (Right (result4,world4)) = runSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinOutputMode h OutputDefault High >> getPinOutputMode h) initialMockWorld [testChip4] in do result1 `shouldBe` OutputDefault result2 `shouldBe` OutputDefault result3 `shouldBe` OutputDefault result4 `shouldBe` OutputDefault Map.lookup (Pin 1) (mockWorldPins world1) `shouldBe` Just (defaultMockPinState {_direction = Out, _activeLow = True, _value = Low}) Map.lookup (Pin 1) (mockWorldPins world2) `shouldBe` Just (defaultMockPinState {_direction = Out, _activeLow = True, _value = High}) Map.lookup (Pin 1) (mockWorldPins world3) `shouldBe` Just (defaultMockPinState {_direction = Out, _activeLow = True, _value = High}) Map.lookup (Pin 1) (mockWorldPins world4) `shouldBe` Just (defaultMockPinState {_direction = Out, _activeLow = True, _value = Low}) it "fails when the output mode is unsupported" $ evalSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinOutputMode h OutputPushPull Low) initialMockWorld [chip0] `shouldBe` Left (Just $ (UnsupportedOutputMode OutputPushPull (Pin 1))) it "can change the pin direction to 'Out' when the pin is configured for edge- or level-triggered reads " $ evalSysfsGpioMock' (withPin (Pin 1) $ \h -> do setPinInputMode h InputDefault setPinInterruptMode h RisingEdge setPinOutputMode h OutputDefault Low setPinInputMode h InputDefault setPinInterruptMode h FallingEdge setPinOutputMode h OutputDefault Low setPinInputMode h InputDefault setPinInterruptMode h Level setPinOutputMode h OutputDefault Low return True) initialMockWorld [chip0] `shouldBe` Right True it "fails when the pin's direction is not settable" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_userVisibleDirection = False}] in evalSysfsGpioMock' (withPin (Pin 1) (\h -> setPinOutputMode h OutputDefault Low)) initialMockWorld [testChip] `shouldBe` Left (Just $ NoDirectionAttribute (Pin 1)) describe "getPinInterruptMode" $ do it "gets the pin's interrupt mode" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_edge = Just Falling}] in do evalSysfsGpioMock' (withPin (Pin 1) getPinInterruptMode) initialMockWorld [chip0] `shouldBe` Right Disabled evalSysfsGpioMock' (withPin (Pin 1) getPinInterruptMode) initialMockWorld [testChip] `shouldBe` Right FallingEdge it "fails when the pin's interrupt mode is not settable" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_edge = Nothing}] in evalSysfsGpioMock' (withPin (Pin 1) getPinInterruptMode) initialMockWorld [testChip] `shouldBe` Left (Just $ NoEdgeAttribute (Pin 1)) describe "setPinInterruptMode" $ do it "sets the pin's interrupt mode" $ evalSysfsGpioMock' testSetInterruptMode initialMockWorld [chip0] `shouldBe` Right (Disabled, RisingEdge, FallingEdge, Level) it "is idempotent" $ evalSysfsGpioMock' testSetInterruptModeIdempotent initialMockWorld [chip0] `shouldBe` Right (FallingEdge, FallingEdge) it "fails when the pin's interrupt mode is not settable" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_edge = Nothing}, defaultMockPinState] in evalSysfsGpioMock' testSetInterruptMode initialMockWorld [testChip] `shouldBe` Left (Just $ NoEdgeAttribute (Pin 1)) it "fails when the pin is configured for output" $ evalSysfsGpioMock' (withPin (Pin 1) $ \h -> setPinInterruptMode h Level) initialMockWorld [chip0] `shouldBe` Left (Just $ InvalidOperation (Pin 1)) describe "getPinActiveLevel" $ do context "when active level is high" $ do it "returns the pin's active level" $ evalSysfsGpioMock' (withPin (Pin 1) getPinActiveLevel) initialMockWorld [chip0] `shouldBe` Right ActiveHigh context "when active level is low" $ do it "returns the pin's active level" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_activeLow = True}] in evalSysfsGpioMock' (withPin (Pin 1) getPinActiveLevel) initialMockWorld [testChip] `shouldBe` Right ActiveLow describe "setPinActiveLevel" $ do context "when active level is high" $ do it "sets the pin's active level to low" $ let (Right (result, world)) = runSysfsGpioMock' (withPin (Pin 1) (\h -> setPinActiveLevel h ActiveLow >> getPinActiveLevel h)) initialMockWorld [chip0] in do result `shouldBe` ActiveLow Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just (defaultMockPinState {_activeLow = True}) it "sets the pin's active level to high" $ let (Right (result, world)) = runSysfsGpioMock' (withPin (Pin 1) (\h -> setPinActiveLevel h ActiveHigh >> getPinActiveLevel h)) initialMockWorld [chip0] in do result `shouldBe` ActiveHigh Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just (defaultMockPinState {_activeLow = False}) context "when active level is low" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_activeLow = True}] in do it "sets the pin's active level to low" $ let (Right (result, world)) = runSysfsGpioMock' (withPin (Pin 1) (\h -> setPinActiveLevel h ActiveLow >> getPinActiveLevel h)) initialMockWorld [testChip] in do result `shouldBe` ActiveLow Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just (defaultMockPinState {_activeLow = True}) it "sets the pin's active level to high" $ let (Right (result, world)) = runSysfsGpioMock' (withPin (Pin 1) (\h -> setPinActiveLevel h ActiveHigh >> getPinActiveLevel h)) initialMockWorld [chip0] in do result `shouldBe` ActiveHigh Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just (defaultMockPinState {_activeLow = False}) describe "togglePinActiveLevel" $ do it "toggles the pin's active level when the pin is configured for output" $ evalSysfsGpioMock' (withPin (Pin 1) testTogglePinActiveLevel) initialMockWorld [chip0] `shouldBe` Right (ActiveHigh, ActiveLow, ActiveLow, ActiveHigh, ActiveHigh) it "and when the pin is configured for input" $ evalSysfsGpioMock' (withPin (Pin 1) (\h -> setPinInputMode h InputDefault >> testTogglePinActiveLevel h)) initialMockWorld [chip0] `shouldBe` Right (ActiveHigh, ActiveLow, ActiveLow, ActiveHigh, ActiveHigh) describe "pollPin" $ do it "waits for the specified trigger and returns the pin's value" $ pendingWith "need to implement this" it "blocks when the interrupt mode is Disabled, until it is changed" $ pendingWith "need to implement this" describe "pollPinTimeout" $ do it "waits for the specified trigger and returns the pin's value" $ pendingWith "need to implement this" it "blocks when the interrupt mode is Disabled, until it is changed" $ pendingWith "need to implement this" it "times out" $ pendingWith "need to implement this" describe "readPin" $ do context "returns the pin's logical level" $ do it "when the active level is high" $ evalSysfsGpioMock' (withPin (Pin 1) (\h -> setPinActiveLevel h ActiveHigh >> readPin h)) initialMockWorld [chip0] `shouldBe` Right Low it "when the active level is low" $ evalSysfsGpioMock' (withPin (Pin 1) (\h -> setPinActiveLevel h ActiveLow >> readPin h)) initialMockWorld [chip0] `shouldBe` Right High describe "writePin" $ do context "sets the pin's logical value" $ do it "when the active level is high" $ let Right (result, world) = runSysfsGpioMock' (withPin (Pin 1) testReadWritePin) initialMockWorld [chip0] in do result `shouldBe` (Low, High, Low) Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState it "when the active level is low" $ let Right (result, world) = runSysfsGpioMock' (withPin (Pin 1) (\h -> setPinActiveLevel h ActiveLow >> testReadWritePin h)) initialMockWorld [chip0] in do result `shouldBe` (High, Low, High) Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just (defaultMockPinState {_activeLow = True, _value = Low}) it "is idempotent" $ evalSysfsGpioMock' testReadWritePinIdempotent initialMockWorld [chip0] `shouldBe` Right (Low, Low) it "fails when the pin direction is In" $ evalSysfsGpioMock' testWritePinFailsOnInputPin initialMockWorld [chip0] `shouldBe` Left (Just $ PermissionDenied (Pin 1)) describe "togglePin" $ do it "toggles the pin's value" $ evalSysfsGpioMock' testTogglePinValue initialMockWorld [chip0] `shouldBe` Right (Low, High, High, Low, Low) it "fails when the pin is not configured for output" $ evalSysfsGpioMock' (withPin (Pin 1) (\h -> setPinInputMode h InputDefault >> togglePin h)) initialMockWorld [chip0] `shouldBe` Left (Just $ PermissionDenied (Pin 1)) describe "operations on an invalid handle fail" $ -- Note: When used on an invalid handle, GPIO commands which -- return a 'Maybe' result will fail differently than commands -- which do not. This is by design. do it "in getPinDirection" $ evalSysfsGpioMock' (invalidHandle getPinDirection) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in getPinInputMode" $ evalSysfsGpioMock' (invalidHandle getPinInputMode) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in setPinInputMode" $ evalSysfsGpioMock' (invalidHandle (\d -> setPinInputMode d InputDefault)) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in getPinOutputMode" $ evalSysfsGpioMock' (invalidHandle getPinOutputMode) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in setPinOutputMode" $ evalSysfsGpioMock' (invalidHandle (\h -> setPinOutputMode h OutputDefault Low)) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in readPin" $ evalSysfsGpioMock' (invalidHandle readPin) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in pollPin" $ evalSysfsGpioMock' (invalidHandle pollPin) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in pollPinTimeout" $ evalSysfsGpioMock' (invalidHandle (\h -> pollPinTimeout h 10000)) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in writePin" $ evalSysfsGpioMock' (invalidHandle (\d -> writePin d High)) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in togglePin" $ evalSysfsGpioMock' (invalidHandle togglePin) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in getPinInterruptMode" $ evalSysfsGpioMock' (invalidHandle getPinInterruptMode) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in setPinInterruptMode" $ evalSysfsGpioMock' (invalidHandle (\d -> setPinInterruptMode d Level)) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in getPinActiveLevel" $ evalSysfsGpioMock' (invalidHandle getPinActiveLevel) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in setPinActiveLevel" $ evalSysfsGpioMock' (invalidHandle (\d -> setPinActiveLevel d ActiveHigh)) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) it "in togglePinActiveLevel" $ evalSysfsGpioMock' (invalidHandle togglePinActiveLevel) initialMockWorld [chip0] `shouldBe` Left (Just $ NotExported (Pin 1)) describe "withPin" $ do it "opens and closes the pin as expected" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_value = High}] (Right world) = execSysfsGpioMock' testWithPin initialMockWorld [testChip] in evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio1") world [] `shouldBe` Right False it "throws an exception when the pin doesn't exist" $ evalSysfsGpioMock' testWithPin initialMockWorld [chip1] `shouldBe` Left (Just $ InvalidPin (Pin 1)) it "can nest" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_value = High}, defaultMockPinState] (Right (result, world)) = runSysfsGpioMock' (testNestedWithPin (Pin 1) (Pin 2)) initialMockWorld [testChip] in do result `shouldBe` (High, Low) evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio1") world [] `shouldBe` Right False evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio2") world [] `shouldBe` Right False it "handles double-open and double-close without complaint" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_value = High}, defaultMockPinState] (Right (result, world)) = runSysfsGpioMock' (testNestedWithPin (Pin 1) (Pin 1)) initialMockWorld [testChip] in do result `shouldBe` (Low, Low) evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio1") world [] `shouldBe` Right False it "cleans up when an exception occurs in the computation" $ let (Right (result, world)) = runSysfsGpioMock' (testWithPinError (Pin 1) (Pin 2)) initialMockWorld [chip0] in do result `shouldBe` Nothing evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio1") world [] `shouldBe` Right False evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio2") world [] `shouldBe` Right False describe "InputPin" $ do context "withInputPin" $ do it "opens and configures a pin for input, then closes closes it" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = In}, defaultMockPinState {_direction = Out}] (Right world) = execSysfsGpioMock' (withInputPin (Pin 1) InputDefault Nothing $ \_ -> withInputPin (Pin 2) InputDefault Nothing $ \_ -> return () ) initialMockWorld [testChip] in do evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio1") world [] `shouldBe` Right False evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio2") world [] `shouldBe` Right False Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In} it "sets the pin's input mode" $ evalSysfsGpioMock' (withInputPin (Pin 1) InputDefault Nothing $ \h -> getInputPinInputMode h ) initialMockWorld [chip0] `shouldBe` Right InputDefault it "sets (or doesn't) the pin's active level" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_activeLow = True}, defaultMockPinState {_activeLow = True}] (Right world) = execSysfsGpioMock' (withInputPin (Pin 1) InputDefault Nothing $ \_ -> withInputPin (Pin 2) InputDefault (Just ActiveHigh) $ \_ -> return () ) initialMockWorld [testChip] in do Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _activeLow = True} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _activeLow = False} it "fails if the pin's direction is fixed" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState, defaultMockPinState {_direction = Out, _userVisibleDirection = False}] in evalSysfsGpioMock' (withInputPin (Pin 1) InputDefault Nothing $ \_ -> withInputPin (Pin 2) InputDefault (Just ActiveHigh) $ \_ -> return () ) initialMockWorld [testChip] `shouldBe` Left (Just $ NoDirectionAttribute (Pin 2)) context "readInputPin" $ do it "respects the pin's active level" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_value = High}, defaultMockPinState {_value = Low}] in evalSysfsGpioMock' (withInputPin (Pin 1) InputDefault Nothing $ \h1 -> withInputPin (Pin 2) InputDefault (Just ActiveLow) $ \h2 -> do v1 <- readInputPin h1 v2 <- readInputPin h2 return (v1,v2) ) initialMockWorld [testChip] `shouldBe` Right (High,High) context "getInputPinInputMode" $ do it "gets the pin's input mode" $ evalSysfsGpioMock' (withInputPin (Pin 1) InputDefault Nothing $ \h -> getInputPinInputMode h ) initialMockWorld [chip0] `shouldBe` Right InputDefault context "get/setInputPinActiveLevel" $ do it "gets/sets the pin's active level" $ let (Right (result, world)) = runSysfsGpioMock' (withInputPin (Pin 1) InputDefault (Just ActiveHigh) $ \h1 -> withInputPin (Pin 2) InputDefault (Just ActiveLow) $ \h2 -> do setInputPinActiveLevel h1 ActiveLow setInputPinActiveLevel h2 ActiveHigh l1 <- getInputPinActiveLevel h1 l2 <- getInputPinActiveLevel h2 return (l1,l2) ) initialMockWorld [chip0] in do result `shouldBe` (ActiveLow,ActiveHigh) Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _activeLow = True} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _activeLow = False} context "toggleInputPinActiveLevel" $ do it "toggles the pin's active level and returns the new value" $ let (Right (result, world)) = runSysfsGpioMock' (withInputPin (Pin 1) InputDefault (Just ActiveHigh) $ \h1 -> withInputPin (Pin 2) InputDefault (Just ActiveLow) $ \h2 -> do l1 <- toggleInputPinActiveLevel h1 l2 <- toggleInputPinActiveLevel h2 return (l1,l2) ) initialMockWorld [chip0] in do result `shouldBe` (ActiveLow,ActiveHigh) Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _activeLow = True} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _activeLow = False} describe "InterruptPin" $ do context "withInterruptPin" $ do it "opens and configures a pin for interrupts, sets its interrupt mode, then closes closes it" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = In, _edge = Just None}, defaultMockPinState {_direction = Out, _edge = Just Rising}] (Right world) = execSysfsGpioMock' (withInterruptPin (Pin 1) InputDefault FallingEdge Nothing $ \_ -> withInterruptPin (Pin 2) InputDefault Disabled Nothing $ \_ -> return () ) initialMockWorld [testChip] in do evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio1") world [] `shouldBe` Right False evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio2") world [] `shouldBe` Right False Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _edge = Just Falling} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _edge = Just None} it "sets (or doesn't) the pin's active level" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_activeLow = True}, defaultMockPinState {_activeLow = True}] (Right world) = execSysfsGpioMock' (withInterruptPin (Pin 1) InputDefault Disabled Nothing $ \_ -> withInterruptPin (Pin 2) InputDefault Disabled (Just ActiveHigh) $ \_ -> return () ) initialMockWorld [testChip] in do Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _activeLow = True} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _activeLow = False} it "fails if the pin's direction is fixed" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState, defaultMockPinState {_direction = Out, _userVisibleDirection = False}] in evalSysfsGpioMock' (withInterruptPin (Pin 1) InputDefault Disabled Nothing $ \_ -> withInterruptPin (Pin 2) InputDefault Disabled (Just ActiveHigh) $ \_ -> return () ) initialMockWorld [testChip] `shouldBe` Left (Just $ NoDirectionAttribute (Pin 2)) it "fails if the pin doesn't support interrupts" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState, defaultMockPinState {_edge = Nothing}] in evalSysfsGpioMock' (withInterruptPin (Pin 1) InputDefault Disabled Nothing $ \_ -> withInterruptPin (Pin 2) InputDefault Disabled (Just ActiveHigh) $ \_ -> return () ) initialMockWorld [testChip] `shouldBe` Left (Just $ NoEdgeAttribute (Pin 2)) context "readInterruptPin" $ do it "respects the pin's active level" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_value = High}, defaultMockPinState {_value = Low}] in evalSysfsGpioMock' (withInterruptPin (Pin 1) InputDefault Disabled Nothing $ \h1 -> withInterruptPin (Pin 2) InputDefault Disabled (Just ActiveLow) $ \h2 -> do v1 <- readInterruptPin h1 v2 <- readInterruptPin h2 return (v1,v2) ) initialMockWorld [testChip] `shouldBe` Right (High,High) context "getInterruptPinInputMode" $ do it "gets the pin's input mode" $ evalSysfsGpioMock' (withInterruptPin (Pin 1) InputDefault Disabled Nothing $ \h -> getInterruptPinInputMode h ) initialMockWorld [chip0] `shouldBe` Right InputDefault context "get/setInterruptPinActiveLevel" $ do it "gets/sets the pin's active level" $ let (Right (result, world)) = runSysfsGpioMock' (withInterruptPin (Pin 1) InputDefault Disabled (Just ActiveHigh) $ \h1 -> withInterruptPin (Pin 2) InputDefault Disabled (Just ActiveLow) $ \h2 -> do setInterruptPinActiveLevel h1 ActiveLow setInterruptPinActiveLevel h2 ActiveHigh l1 <- getInterruptPinActiveLevel h1 l2 <- getInterruptPinActiveLevel h2 return (l1,l2) ) initialMockWorld [chip0] in do result `shouldBe` (ActiveLow,ActiveHigh) Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _activeLow = True} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _activeLow = False} context "toggleInterruptPinActiveLevel" $ do it "toggles the pin's active level and returns the new value" $ let (Right (result, world)) = runSysfsGpioMock' (withInterruptPin (Pin 1) InputDefault Disabled (Just ActiveHigh) $ \h1 -> withInterruptPin (Pin 2) InputDefault Disabled (Just ActiveLow) $ \h2 -> do l1 <- toggleInterruptPinActiveLevel h1 l2 <- toggleInterruptPinActiveLevel h2 return (l1,l2) ) initialMockWorld [chip0] in do result `shouldBe` (ActiveLow,ActiveHigh) Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _activeLow = True} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _activeLow = False} context "get/setInterruptPinInterruptMode" $ do it "gets/sets the pin's interrupt mode" $ let (Right (result, world)) = runSysfsGpioMock' (withInterruptPin (Pin 1) InputDefault Disabled Nothing $ \h1 -> withInterruptPin (Pin 2) InputDefault RisingEdge Nothing $ \h2 -> do setInterruptPinInterruptMode h1 RisingEdge setInterruptPinInterruptMode h2 Disabled m1 <- getInterruptPinInterruptMode h1 m2 <- getInterruptPinInterruptMode h2 return (m1,m2) ) initialMockWorld [chip0] in do result `shouldBe` (RisingEdge,Disabled) Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _edge = Just Rising} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = In, _edge = Just None} context "pollInterruptPin" $ do it "waits for interrupts" $ pendingWith "need to implement this" it "respects the pin's active level" $ pendingWith "need to implement this" context "pollInterruptPin" $ do it "waits for interrupts" $ pendingWith "need to implement this" it "times out" $ pendingWith "need to implement this" it "respects the pin's active level" $ pendingWith "need to implement this" describe "OutputPin" $ do context "withOutputPin" $ do it "opens and configures a pin for output, sets its value, then closes closes it" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState {_direction = In}, defaultMockPinState {_direction = Out, _value = High}] (Right world) = execSysfsGpioMock' (withOutputPin (Pin 1) OutputDefault Nothing High $ \_ -> withOutputPin (Pin 2) OutputDefault Nothing Low $ \_ -> return () ) initialMockWorld [testChip] in do evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio1") world [] `shouldBe` Right False evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/gpio2") world [] `shouldBe` Right False Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _value = High} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _value = Low} it "sets (or doesn't) the pin's active level (and the output value is relative to it)" $ let (Right world) = execSysfsGpioMock' (withOutputPin (Pin 1) OutputDefault Nothing Low $ \_ -> withOutputPin (Pin 2) OutputDefault Nothing High $ \_ -> withOutputPin (Pin 3) OutputDefault (Just ActiveLow) Low $ \_ -> withOutputPin (Pin 4) OutputDefault (Just ActiveLow) High $ \_ -> withOutputPin (Pin 5) OutputDefault (Just ActiveHigh) Low $ \_ -> withOutputPin (Pin 6) OutputDefault (Just ActiveHigh) High $ \_ -> return () ) initialMockWorld [chip0] in do Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _value = High} Map.lookup (Pin 3) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _activeLow = True, _value = High} Map.lookup (Pin 4) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _activeLow = True, _value = Low} Map.lookup (Pin 5) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _value = Low} Map.lookup (Pin 6) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _value = High} it "fails if the pin's direction is fixed" $ let testChip = MockGpioChip "testChip" 1 [defaultMockPinState, defaultMockPinState {_direction = Out, _userVisibleDirection = False}] in evalSysfsGpioMock' (withOutputPin (Pin 1) OutputDefault Nothing High $ \_ -> withOutputPin (Pin 2) OutputDefault Nothing Low $ \_ -> return () ) initialMockWorld [testChip] `shouldBe` Left (Just $ NoDirectionAttribute (Pin 2)) context "readOutputPin" $ do it "respects the pin's active level" $ evalSysfsGpioMock' (withOutputPin (Pin 1) OutputDefault Nothing Low $ \h1 -> withOutputPin (Pin 2) OutputDefault (Just ActiveLow) High $ \h2 -> do v1 <- readOutputPin h1 v2 <- readOutputPin h2 return (v1,v2) ) initialMockWorld [chip0] `shouldBe` Right (Low,High) context "writeOutputPin" $ do it "writes the output value and respects the pin's active level" $ let (Right world) = execSysfsGpioMock' (withOutputPin (Pin 1) OutputDefault (Just ActiveLow) High $ \h1 -> withOutputPin (Pin 2) OutputDefault (Just ActiveLow) Low $ \h2 -> withOutputPin (Pin 3) OutputDefault (Just ActiveHigh) High $ \h3 -> withOutputPin (Pin 4) OutputDefault (Just ActiveHigh) Low $ \h4 -> do writeOutputPin h1 Low writeOutputPin h2 High writeOutputPin h3 Low writeOutputPin h4 High ) initialMockWorld [chip0] in do Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _activeLow = True, _value = High} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _activeLow = True, _value = Low} Map.lookup (Pin 3) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _value = Low} Map.lookup (Pin 4) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _value = High} context "toggleOutputPin" $ do it "toggles the output value, returns the new value, and respects the pin's active level" $ let (Right (result, world)) = runSysfsGpioMock' (withOutputPin (Pin 1) OutputDefault (Just ActiveLow) High $ \h1 -> withOutputPin (Pin 2) OutputDefault (Just ActiveLow) Low $ \h2 -> withOutputPin (Pin 3) OutputDefault (Just ActiveHigh) High $ \h3 -> withOutputPin (Pin 4) OutputDefault (Just ActiveHigh) Low $ \h4 -> do v1 <- toggleOutputPin h1 v2 <- toggleOutputPin h2 v3 <- toggleOutputPin h3 v4 <- toggleOutputPin h4 return (v1,v2,v3,v4) ) initialMockWorld [chip0] in do result `shouldBe` (Low,High,Low,High) Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _activeLow = True, _value = High} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _activeLow = True, _value = Low} Map.lookup (Pin 3) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _value = Low} Map.lookup (Pin 4) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _value = High} context "getOutputPinOutputMode" $ do it "gets the pin's input mode" $ evalSysfsGpioMock' (withOutputPin (Pin 1) OutputDefault Nothing Low $ \h -> getOutputPinOutputMode h ) initialMockWorld [chip0] `shouldBe` Right OutputDefault context "get/setOutputPinActiveLevel" $ do it "gets/sets the pin's active level" $ let (Right (result, world)) = runSysfsGpioMock' (withOutputPin (Pin 1) OutputDefault (Just ActiveHigh) Low $ \h1 -> withOutputPin (Pin 2) OutputDefault (Just ActiveLow) Low $ \h2 -> do setOutputPinActiveLevel h1 ActiveLow setOutputPinActiveLevel h2 ActiveHigh l1 <- getOutputPinActiveLevel h1 l2 <- getOutputPinActiveLevel h2 return (l1,l2) ) initialMockWorld [chip0] in do result `shouldBe` (ActiveLow,ActiveHigh) Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _activeLow = True} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _activeLow = False, _value = High} context "toggleOutputPinActiveLevel" $ do it "toggles the pin's active level and returns the new value" $ let (Right (result, world)) = runSysfsGpioMock' (withOutputPin (Pin 1) OutputDefault (Just ActiveHigh) Low $ \h1 -> withOutputPin (Pin 2) OutputDefault (Just ActiveLow) Low $ \h2 -> do l1 <- toggleOutputPinActiveLevel h1 l2 <- toggleOutputPinActiveLevel h2 return (l1,l2) ) initialMockWorld [chip0] in do result `shouldBe` (ActiveLow,ActiveHigh) Map.lookup (Pin 1) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _activeLow = True} Map.lookup (Pin 2) (mockWorldPins world) `shouldBe` Just defaultMockPinState {_direction = Out, _activeLow = False, _value = High}