hpio 0.8.0.0 → 0.8.0.1

raw patch · 11 files changed

+2683/−15 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• .travis.yml +32/−11
• changelog.md +8/−0
• default.nix +1/−1
• hpio.cabal +9/−2
• shell.nix +1/−1
• test/Spec.hs +1/−0
• test/System/GPIO/Linux/Sysfs/LinuxBboneSpec.hs +1144/−0
• test/System/GPIO/Linux/Sysfs/MockInternalSpec.hs +328/−0
• test/System/GPIO/Linux/Sysfs/MockSpec.hs +138/−0
• test/System/GPIO/Linux/Sysfs/SysfsGpioMockSpec.hs +879/−0
• test/System/GPIO/TypesSpec.hs +142/−0

@@ -104,35 +104,56 @@     curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'   fi +  # Use the more reliable S3 mirror of Hackage+  mkdir -p $HOME/.cabal+  echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config+  echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config  ++  if [ "$CABALVER" != "1.16" ]+  then+    echo 'jobs: $ncpus' >> $HOME/.cabal/config+  fi++# Get the list of packages from the stack.yaml file+- PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@')+ install: - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - if [ -f configure.ac ]; then autoreconf -i; fi - |+  set -ex   case "$BUILD" in     stack)-      stack --no-terminal --install-ghc $ARGS test --only-dependencies+      stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies       ;;     cabal)       cabal --version       travis_retry cabal update-      cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS+      cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES       ;;   esac+  set +ex  script: - |+  set -ex   case "$BUILD" in     stack)-      stack --no-terminal $ARGS test --haddock --no-haddock-deps+      stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps       ;;     cabal)-      cabal configure --enable-tests --enable-benchmarks -v2 --ghc-options="-O0 -Werror"-      cabal build-      cabal check || [ "$CABALVER" == "1.16" ]-      cabal test-      cabal sdist-      cabal copy-      SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && \-        (cd dist && cabal install --force-reinstalls "$SRC_TGZ")+      cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES++      ORIGDIR=$(pwd)+      for dir in $PACKAGES+      do+        cd $dir+        cabal check || [ "$CABALVER" == "1.16" ]+        cabal sdist+        SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && \+          (cd dist && cabal install --force-reinstalls "$SRC_TGZ")+        cd $ORIGDIR+      done       ;;   esac+  set +ex

@@ -0,0 +1,8 @@+## 0.8.0.1 (2016-05-30)++Fixes:+  - Fix sdist problem with test files (#47)++## 0.8.0.0 (2016-05-27)++Initial release.

@@ -5,7 +5,7 @@ }: mkDerivation {   pname = "hpio";-  version = "0.8.0.0";+  version = "0.8.0.1";   src = ./.;   isLibrary = true;   isExecutable = true;

@@ -1,5 +1,5 @@ Name:                   hpio-Version:                0.8.0.0+Version:                0.8.0.1 Cabal-Version:          >= 1.10 Build-Type:             Simple Author:                 Drew Hess <src@drewhess.com>@@ -29,6 +29,7 @@ Extra-Doc-Files:        README.md Extra-Source-Files:     .travis.yml                       , Hlint.hs+                      , changelog.md                       , default.nix                       , shell.nix                       , stack.yaml@@ -239,6 +240,12 @@                       , System.GPIO.Monad                       , System.GPIO.Tutorial                       , System.GPIO.Types+                      , Spec+                      , System.GPIO.TypesSpec+                      , System.GPIO.Linux.Sysfs.LinuxBboneSpec+                      , System.GPIO.Linux.Sysfs.MockInternalSpec+                      , System.GPIO.Linux.Sysfs.MockSpec+                      , System.GPIO.Linux.Sysfs.SysfsGpioMockSpec   C-Sources:            src/System/GPIO/Linux/Sysfs/pollSysfs.c   If flag(linux-bbone-tests)     cpp-options: -DRUN_LINUX_BBONE_TESTS=1@@ -250,4 +257,4 @@ Source-Repository this   Type:                 git   Location:             git://github.com/dhess/hpio.git-  Tag:                  v0.8.0.0+  Tag:                  v0.8.0.1

@@ -11,7 +11,7 @@       }:       mkDerivation {         pname = "hpio";-        version = "0.8.0.0";+        version = "0.8.0.1";         src = ./.;         isLibrary = true;         isExecutable = true;

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}

@@ -0,0 +1,1144 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-binds #-}++module System.GPIO.Linux.Sysfs.LinuxBboneSpec (spec) where++import Control.Concurrent (forkIO, threadDelay)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Control.Monad (void)+import Control.Monad.Catch (throwM)+import Control.Monad.IO.Class (MonadIO, liftIO)+import System.Directory (doesDirectoryExist)+import System.GPIO.Linux.Sysfs (SysfsException(..), runSysfsGpioIO)+import System.GPIO.Monad (MonadGpio(..), withPin)+import System.GPIO.Types+       (Pin(..), PinInputMode(..), PinOutputMode(..), PinActiveLevel(..),+        PinDirection(..), PinInterruptMode(..), PinValue(..))+import Test.Hspec++isInvalidPinError :: SysfsException -> Bool+isInvalidPinError (InvalidPin _) = True+isInvalidPinError _ = False++isNotExportedError :: SysfsException -> Bool+isNotExportedError (NotExported _) = True+isNotExportedError _ = False++isUnsupportedInputMode :: SysfsException -> Bool+isUnsupportedInputMode (UnsupportedInputMode _ _) = True+isUnsupportedInputMode _ = False++isUnsupportedOutputMode :: SysfsException -> Bool+isUnsupportedOutputMode (UnsupportedOutputMode _ _) = True+isUnsupportedOutputMode _ = False++isPermissionDeniedError :: SysfsException -> Bool+isPermissionDeniedError (PermissionDenied _) = True+isPermissionDeniedError _ = False++isInvalidOperationError :: SysfsException -> Bool+isInvalidOperationError (InvalidOperation _) = True+isInvalidOperationError _ = False++-- Note: it's not practical to test all exceptional cases, but we do+-- our best.++-- Note: make sure the tests are always compiled, but only actually+-- run on the proper platform.+spec :: Spec+spec =+#ifdef RUN_LINUX_BBONE_TESTS+  runTests+#else+  describe "Linux BeagleBone tests disabled on this platform" $ return ()+#endif++-- NOTE: In order to run these tests properly, the following must be true:+--+-- * They must be run on BeagleBone Black hardware running Linux.+-- * You must have permission to export and unexport pins via the+--   sysfs GPIO filesystem.+-- * You must have permission to write pin attributes via the sysfs+--   GPIO filesystem.+-- * GPIO pins P9-15 (sysfs GPIO pin number 48) and P8-15 (sysfs GPIO+--   pin number 47) must be jumpered together.++testPin1 :: Pin+testPin1 = Pin 48++testPin2 :: Pin+testPin2 = Pin 47++invalidPin :: Pin+invalidPin = Pin 9000++-- Note: tests which modify pin state have a slight delay between+-- opening the pin and modifying any state. This is so that, if the+-- user running the tests is not root and is using a udev action to+-- change pin ownership (which is the only way at the time of writing+-- to do that), the script has time to run.++udevScriptWait :: MonadIO m => m ()+udevScriptWait = liftIO $ threadDelay 500000++runTests :: Spec+runTests =+  do+    describe "runSysfsGpioIO" $+      do context "pins" $+           it "returns the full list of pins on the system" $+             runSysfsGpioIO pins `shouldReturn` (map Pin [0..127])+         context "openPin/closePin" $+           do it "exports/unexports the pin" $+                runSysfsGpioIO+                  (do h <- openPin testPin1+                      exported <- liftIO $ doesDirectoryExist "/sys/class/gpio/gpio48"+                      closePin h+                      stillExported <- liftIO $ doesDirectoryExist "/sys/class/gpio/gpio48"+                      return (exported, stillExported))+                `shouldReturn` (True, False)+              it "openPin doesn't complain if the pin is already exported" $+                  runSysfsGpioIO+                    (withPin testPin1 $ \_ ->+                       do h <- openPin testPin1+                          void $ getPinDirection h+                          return True)+                    `shouldReturn` True+              it "openPin fails if the pin is invalid" $+                  runSysfsGpioIO+                    (do h <- openPin invalidPin+                        dir <- getPinDirection h+                        return dir)+                    `shouldThrow` isInvalidPinError+              it "closePin doesn't complain the pin is already unexported" $+                  runSysfsGpioIO+                    (withPin testPin1 $ \_ ->+                       do h <- openPin testPin1+                          closePin h+                          closePin h)+                    `shouldReturn` ()+         context "withPin" $+           do it "exports/unexports the pin" $+                do runSysfsGpioIO+                     (withPin testPin1 $ const $+                        liftIO $ doesDirectoryExist "/sys/class/gpio/gpio48")+                     `shouldReturn` True+                   doesDirectoryExist "/sys/class/gpio/gpio48" `shouldReturn` False+              it "unexports the pin upon exception" $+                do runSysfsGpioIO+                     (withPin testPin1 $ const $+                        throwM $ userError "Foo")+                     `shouldThrow` anyIOException+                   doesDirectoryExist "/sys/class/gpio/gpio48" `shouldReturn` False+              it "handles double-open and double-close gracefully" $+                do runSysfsGpioIO+                     (withPin testPin1 $ const $+                        withPin testPin1 $ const $+                          liftIO $ doesDirectoryExist "/sys/class/gpio/gpio48")+                     `shouldReturn` True+                   doesDirectoryExist "/sys/class/gpio/gpio48" `shouldReturn` False+              it "fails if the pin is invalid" $+                do runSysfsGpioIO+                     (withPin invalidPin $ const $+                        liftIO $ doesDirectoryExist "/sys/class/gpio/gpio9000")+                     `shouldThrow` isInvalidPinError+         context "getPinDirection" $+           do it "gets the pin's direction" $+                runSysfsGpioIO+                  (withPin testPin1 $ \h ->+                    do udevScriptWait+                       setPinInputMode h InputDefault+                       dir1 <- getPinDirection h+                       setPinOutputMode h OutputDefault Low+                       dir2 <- getPinDirection h+                       setPinInputMode h InputDefault+                       dir3 <- getPinDirection h+                       return (dir1, dir2, dir3))+                  `shouldReturn` (In, Out, In)+         context "getPinInputMode" $+           do it "gets the pin's input mode" $+                runSysfsGpioIO+                   (withPin testPin1 $ \h ->+                     do udevScriptWait+                        setPinInputMode h InputDefault+                        getPinInputMode h)+                   `shouldReturn` InputDefault+              it "fails when the pin is in output mode" $+                runSysfsGpioIO+                  (withPin testPin1 $ \h ->+                    do udevScriptWait+                       setPinOutputMode h OutputDefault Low+                       getPinInputMode h)+                  `shouldThrow` isInvalidOperationError+         context "setPinInputMode" $+           do it "sets the pin's input mode and direction" $+                do runSysfsGpioIO+                     (withPin testPin1 $ \h ->+                       do udevScriptWait+                          setPinInputMode h InputDefault+                          m <- getPinInputMode h+                          d <- getPinDirection h+                          return (m,d))+                     `shouldReturn` (InputDefault,In)+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                        do udevScriptWait+                           setPinOutputMode h OutputDefault Low+                           setPinInputMode h InputDefault+                           m <- getPinInputMode h+                           d <- getPinDirection h+                           return (m,d))+                      `shouldReturn` (InputDefault,In)+              it "fails when the input mode is unsupported" $+                runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                        do udevScriptWait+                           setPinInputMode h InputPullDown+                           getPinInputMode h)+                      `shouldThrow` isUnsupportedInputMode+         context "getPinOutputMode" $+            do it "gets the pin's input mode" $+                 runSysfsGpioIO+                    (withPin testPin1 $ \h ->+                      do udevScriptWait+                         setPinOutputMode h OutputDefault Low+                         getPinOutputMode h)+                    `shouldReturn` OutputDefault+               it "fails when the pin is in input mode" $+                 runSysfsGpioIO+                   (withPin testPin1 $ \h ->+                     do udevScriptWait+                        setPinInputMode h InputDefault+                        getPinOutputMode h)+                   `shouldThrow` isInvalidOperationError+         context "setPinOutputMode" $+           do it "sets the pin's output mode, direction, and value" $+                do runSysfsGpioIO+                     (withPin testPin1 $ \h ->+                       do udevScriptWait+                          setPinInputMode h InputDefault+                          setPinActiveLevel h ActiveHigh+                          setPinOutputMode h OutputDefault Low+                          v <- readPin h+                          m <- getPinOutputMode h+                          d <- getPinDirection h+                          return (v,m,d))+                     `shouldReturn` (Low,OutputDefault,Out)+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                        do udevScriptWait+                           setPinInputMode h InputDefault+                           setPinActiveLevel h ActiveHigh+                           setPinOutputMode h OutputDefault High+                           v <- readPin h+                           m <- getPinOutputMode h+                           d <- getPinDirection h+                           return (v,m,d))+                      `shouldReturn` (High,OutputDefault,Out)+                   runSysfsGpioIO+                     (withPin testPin1 $ \h ->+                       do udevScriptWait+                          setPinActiveLevel h ActiveHigh+                          setPinInputMode h InputDefault+                          setPinOutputMode h OutputDefault High+                          v <- readPin h+                          m <- getPinOutputMode h+                          d <- getPinDirection h+                          return (v,m,d))+                     `shouldReturn` (High,OutputDefault,Out)+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                        do udevScriptWait+                           setPinActiveLevel h ActiveHigh+                           setPinInputMode h InputDefault+                           setPinOutputMode h OutputDefault Low+                           v <- readPin h+                           m <- getPinOutputMode h+                           d <- getPinDirection h+                           return (v,m,d))+                      `shouldReturn` (Low,OutputDefault,Out)+              it "respects the pin's active level" $+                 do runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                        do udevScriptWait+                           setPinInputMode h InputDefault+                           setPinActiveLevel h ActiveLow+                           setPinOutputMode h OutputDefault Low+                           setPinActiveLevel h ActiveHigh+                           v <- readPin h+                           m <- getPinOutputMode h+                           d <- getPinDirection h+                           return (v,m,d))+                      `shouldReturn` (High,OutputDefault,Out)+                    runSysfsGpioIO+                       (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveLow+                            setPinOutputMode h OutputDefault High+                            setPinActiveLevel h ActiveHigh+                            v <- readPin h+                            m <- getPinOutputMode h+                            d <- getPinDirection h+                            return (v,m,d))+                       `shouldReturn` (Low,OutputDefault,Out)+                    runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                        do udevScriptWait+                           setPinActiveLevel h ActiveLow+                           setPinInputMode h InputDefault+                           setPinOutputMode h OutputDefault High+                           setPinActiveLevel h ActiveHigh+                           v <- readPin h+                           m <- getPinOutputMode h+                           d <- getPinDirection h+                           return (v,m,d))+                      `shouldReturn` (Low,OutputDefault,Out)+                    runSysfsGpioIO+                       (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinActiveLevel h ActiveLow+                            setPinInputMode h InputDefault+                            setPinOutputMode h OutputDefault Low+                            setPinActiveLevel h ActiveHigh+                            v <- readPin h+                            m <- getPinOutputMode h+                            d <- getPinDirection h+                            return (v,m,d))+                       `shouldReturn` (High,OutputDefault,Out)+              it "can set the pin's direction to 'Out' when it's configured for edge-triggered reads" $+                runSysfsGpioIO+                  (withPin testPin1 $ \h ->+                    do udevScriptWait+                       setPinInputMode h InputDefault+                       setPinInterruptMode h RisingEdge+                       setPinOutputMode h OutputDefault Low+                       setPinInputMode h InputDefault+                       setPinInterruptMode h FallingEdge+                       setPinOutputMode h OutputDefault High+                       setPinInputMode h InputDefault+                       setPinInterruptMode h Level+                       setPinOutputMode h OutputDefault Low+                       return True)+                  `shouldReturn` True+              it "fails when the output mode is unsupported" $+                 runSysfsGpioIO+                       (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinOutputMode h OutputOpenSourcePullDown Low+                            getPinInputMode h)+                       `shouldThrow` isUnsupportedOutputMode+         context "getPinActiveLevel/setPinActiveLevel" $+           it "gets and sets the pin's active level" $+             runSysfsGpioIO+               (withPin testPin1 $ \h ->+                 do udevScriptWait+                    setPinActiveLevel h ActiveLow+                    level1 <- getPinActiveLevel h+                    setPinActiveLevel h ActiveHigh+                    level2 <- getPinActiveLevel h+                    setPinActiveLevel h ActiveLow+                    level3 <- getPinActiveLevel h+                    return (level1, level2, level3))+               `shouldReturn` (ActiveLow, ActiveHigh, ActiveLow)+         context "togglePinActiveLevel" $+           it "toggles the pin's active level" $+             runSysfsGpioIO+               (withPin testPin1 $ \h ->+                 do udevScriptWait+                    setPinActiveLevel h ActiveHigh+                    level1 <- togglePinActiveLevel h+                    level2 <- togglePinActiveLevel h+                    level3 <- togglePinActiveLevel h+                    return (level1, level2, level3))+               `shouldReturn` (ActiveLow, ActiveHigh, ActiveLow)+         context "readPin/writePin" $+           -- Note: if these tests fail, you might not have hooked pin+           -- P9-15 up to pin P8-15!+           do it "reads and writes the pin's value" $+                runSysfsGpioIO+                  (withPin testPin1 $ \h1 ->+                     withPin testPin2 $ \h2 ->+                       do udevScriptWait+                          setPinInputMode h1 InputDefault+                          setPinActiveLevel h1 ActiveHigh+                          setPinActiveLevel h2 ActiveHigh+                          setPinOutputMode h2 OutputDefault High+                          -- give the pin time to settle+                          liftIO $ threadDelay 250000+                          val1 <- readPin h1+                          writePin h2 Low+                          liftIO $ threadDelay 250000+                          val2 <- readPin h1+                          writePin h2 High+                          liftIO $ threadDelay 250000+                          val3 <- readPin h1+                          return (val1, val2, val3))+                  `shouldReturn` (High, Low, High)+              it "readPin obeys the pin's active level" $+                runSysfsGpioIO+                  (withPin testPin1 $ \h1 ->+                     withPin testPin2 $ \h2 ->+                       do udevScriptWait+                          setPinInputMode h1 InputDefault+                          setPinActiveLevel h1 ActiveLow+                          setPinActiveLevel h2 ActiveHigh+                          setPinOutputMode h2 OutputDefault High+                          -- give the pin time to settle+                          liftIO $ threadDelay 250000+                          val1 <- readPin h1+                          writePin h2 Low+                          liftIO $ threadDelay 250000+                          val2 <- readPin h1+                          writePin h2 High+                          liftIO $ threadDelay 250000+                          val3 <- readPin h1+                          return (val1, val2, val3))+                  `shouldReturn` (Low, High, Low)+              it "readPin works on output pins" $+                 runSysfsGpioIO+                   (withPin testPin2 $ \h ->+                      do udevScriptWait+                         setPinActiveLevel h ActiveHigh+                         setPinOutputMode h OutputDefault High+                         liftIO $ threadDelay 250000+                         val1 <- readPin h+                         writePin h Low+                         liftIO $ threadDelay 250000+                         val2 <- readPin h+                         writePin h High+                         liftIO $ threadDelay 250000+                         val3 <- readPin h+                         return (val1, val2, val3))+                   `shouldReturn` (High, Low, High)+              it "readPin works on output pins (active-low)" $+                 runSysfsGpioIO+                   (withPin testPin2 $ \h ->+                      do udevScriptWait+                         setPinActiveLevel h ActiveLow+                         setPinOutputMode h OutputDefault High+                         liftIO $ threadDelay 250000+                         val1 <- readPin h+                         writePin h Low+                         liftIO $ threadDelay 250000+                         val2 <- readPin h+                         writePin h High+                         liftIO $ threadDelay 250000+                         val3 <- readPin h+                         return (val1, val2, val3))+                   `shouldReturn` (High, Low, High)+              it "writePin obeys the pin's active level" $+                runSysfsGpioIO+                  (withPin testPin1 $ \h1 ->+                     withPin testPin2 $ \h2 ->+                       do udevScriptWait+                          setPinInputMode h1 InputDefault+                          setPinActiveLevel h1 ActiveHigh+                          setPinActiveLevel h2 ActiveLow+                          setPinOutputMode h2 OutputDefault High+                          -- give the pin time to settle+                          liftIO $ threadDelay 250000+                          val1 <- readPin h1+                          writePin h2 Low+                          liftIO $ threadDelay 250000+                          val2 <- readPin h1+                          writePin h2 High+                          liftIO $ threadDelay 250000+                          val3 <- readPin h1+                          return (val1, val2, val3))+                  `shouldReturn` (Low, High, Low)+              it "fails if the pin is configured for input" $+                runSysfsGpioIO+                  (withPin testPin1 $ \h ->+                     do udevScriptWait+                        setPinInputMode h InputDefault+                        writePin h High)+                  `shouldThrow` isPermissionDeniedError+         context "togglePin" $+           -- Note: if these tests fail, you might not have hooked pin+           -- P9-15 up to pin P8-15!+           do it "toggles the pin's value and returns the previous value" $+                runSysfsGpioIO+                  (withPin testPin1 $ \h1 ->+                     withPin testPin2 $ \h2 ->+                       do udevScriptWait+                          setPinInputMode h1 InputDefault+                          setPinActiveLevel h1 ActiveHigh+                          setPinActiveLevel h2 ActiveHigh+                          setPinOutputMode h2 OutputDefault Low+                          h2_val1 <- togglePin h2+                          -- give the pin time to settle+                          liftIO $ threadDelay 250000+                          h1_val1 <- readPin h1+                          h2_val2 <- togglePin h2+                          liftIO $ threadDelay 250000+                          h1_val2 <- readPin h1+                          h2_val3 <- togglePin h2+                          liftIO $ threadDelay 250000+                          h1_val3 <- readPin h1+                          return (h2_val1, h1_val1, h2_val2, h1_val2, h2_val3, h1_val3))+                  `shouldReturn` (High, High, Low, Low, High, High)+              it "togglePin obeys the pin's active level" $+                runSysfsGpioIO+                  (withPin testPin1 $ \h1 ->+                     withPin testPin2 $ \h2 ->+                       do udevScriptWait+                          setPinInputMode h1 InputDefault+                          setPinActiveLevel h1 ActiveHigh+                          setPinActiveLevel h2 ActiveLow+                          setPinOutputMode h2 OutputDefault Low+                          h2_val1 <- togglePin h2+                          -- give the pin time to settle+                          liftIO $ threadDelay 250000+                          h1_val1 <- readPin h1+                          h2_val2 <- togglePin h2+                          liftIO $ threadDelay 250000+                          h1_val2 <- readPin h1+                          h2_val3 <- togglePin h2+                          liftIO $ threadDelay 250000+                          h1_val3 <- readPin h1+                          return (h2_val1, h1_val1, h2_val2, h1_val2, h2_val3, h1_val3))+                  `shouldReturn` (High, Low, Low, High, High, Low)+              it "fails if the pin is configured for input" $+                runSysfsGpioIO+                  (withPin testPin1 $ \h ->+                     do udevScriptWait+                        setPinInputMode h InputDefault+                        void $ togglePin h)+                  `shouldThrow` isPermissionDeniedError+         context "getPinInterruptMode/setPinInterruptMode" $+           do it "gets and sets the pin's interrupt mode" $+                runSysfsGpioIO+                  (withPin testPin1 $ \h ->+                    do udevScriptWait+                       setPinInputMode h InputDefault+                       setPinInterruptMode h RisingEdge+                       trigger1 <- getPinInterruptMode h+                       setPinInterruptMode h FallingEdge+                       trigger2 <- getPinInterruptMode h+                       setPinInterruptMode h Level+                       trigger3 <- getPinInterruptMode h+                       setPinInterruptMode h Disabled+                       trigger4 <- getPinInterruptMode h+                       return (trigger1, trigger2, trigger3, trigger4))+                `shouldReturn` (RisingEdge, FallingEdge, Level, Disabled)+              it "setPinInterruptMode should fail on an output pin" $+                runSysfsGpioIO+                  (withPin testPin2 $ \h ->+                    do udevScriptWait+                       setPinOutputMode h OutputDefault Low+                       setPinInterruptMode h Level)+                `shouldThrow` isInvalidOperationError+         context "pollPin" $+           -- Note: if these tests fail, you might not have hooked pin+           -- P9-15 up to pin P8-15!+           do it "pollPin waits for rising edge" $+                do mvar <- liftIO $ newEmptyMVar+                   void $ liftIO $ forkIO $+                     do runSysfsGpioIO $+                          withPin testPin2 $ \h ->+                            do udevScriptWait+                               setPinActiveLevel h ActiveHigh+                               setPinOutputMode h OutputDefault High+                               liftIO $ void $ takeMVar mvar+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                        putMVar mvar () -- synchronize finish+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveHigh+                            setPinInterruptMode h RisingEdge+                            liftIO $ putMVar mvar ()+                            val1 <- pollPin h+                            val2 <- pollPin h+                            liftIO $ void $ takeMVar mvar -- synchronize finish+                            return (val1, val2))+                   `shouldReturn` (High, High)+              it "pollPin waits for falling edge" $+                do mvar <- liftIO $ newEmptyMVar+                   void $ liftIO $ forkIO $+                     do runSysfsGpioIO $+                          withPin testPin2 $ \h ->+                            do udevScriptWait+                               setPinActiveLevel h ActiveHigh+                               setPinOutputMode h OutputDefault Low+                               liftIO $ void $ takeMVar mvar+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                        putMVar mvar () -- synchronize finish+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveHigh+                            setPinInterruptMode h FallingEdge+                            liftIO $ putMVar mvar ()+                            val1 <- pollPin h+                            val2 <- pollPin h+                            liftIO $ void $ takeMVar mvar -- synchronize finish+                            return (val1, val2))+                   `shouldReturn` (Low, Low)+              it "pollPin waits for level changes" $+                do mvar <- liftIO $ newEmptyMVar+                   void $ liftIO $ forkIO $+                     do runSysfsGpioIO $+                          withPin testPin2 $ \h ->+                            do udevScriptWait+                               setPinActiveLevel h ActiveHigh+                               setPinOutputMode h OutputDefault High+                               liftIO $ void $ takeMVar mvar+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                        putMVar mvar () -- synchronize finish+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveHigh+                            setPinInterruptMode h Level+                            liftIO $ putMVar mvar ()+                            val1 <- pollPin h+                            val2 <- pollPin h+                            val3 <- pollPin h+                            val4 <- pollPin h+                            liftIO $ void $ takeMVar mvar -- synchronize finish+                            return (val1, val2, val3, val4))+                   `shouldReturn` (Low, High, Low, High)+              it "pollPin can be disabled" $+                do mvar <- liftIO $ newEmptyMVar+                   runSysfsGpioIO+                     (withPin testPin1 $ \inPin ->+                        withPin testPin2 $ \outPin ->+                          do udevScriptWait+                             setPinInputMode inPin InputDefault+                             setPinActiveLevel inPin ActiveHigh+                             setPinInterruptMode inPin Disabled+                             setPinActiveLevel outPin ActiveHigh+                             setPinOutputMode outPin OutputDefault Low+                             void $ liftIO $ forkIO $+                               do runSysfsGpioIO $+                                    do liftIO $ void $ takeMVar mvar+                                       liftIO $ threadDelay 500000+                                       void $ togglePin outPin -- ignored+                                       liftIO $ threadDelay 500000+                                       setPinInterruptMode inPin Level+                                       void $ togglePin outPin -- trigger+                                  putMVar mvar () -- synchronize finish+                             liftIO $ putMVar mvar ()+                             val <- pollPin inPin+                             liftIO $ void $ takeMVar mvar -- synchronize finish+                             return val)+                   `shouldReturn` Low+         context "pollPin with active-low logic" $+           -- Note: if these tests fail, you might not have hooked pin+           -- P9-15 up to pin P8-15!+           do it "pollPin waits for (active-low) rising edge" $+                do mvar <- liftIO $ newEmptyMVar+                   void $ liftIO $ forkIO $+                     do runSysfsGpioIO $+                          withPin testPin2 $ \h ->+                            do udevScriptWait+                               setPinActiveLevel h ActiveHigh+                               setPinOutputMode h OutputDefault Low+                               liftIO $ void $ takeMVar mvar+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                        putMVar mvar () -- synchronize finish+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveLow+                            setPinInterruptMode h RisingEdge+                            liftIO $ putMVar mvar ()+                            val1 <- pollPin h+                            val2 <- pollPin h+                            liftIO $ void $ takeMVar mvar -- synchronize finish+                            return (val1, val2))+                   `shouldReturn` (High, High)+              it "pollPin waits for (active-low) falling edge" $+                do mvar <- liftIO $ newEmptyMVar+                   void $ liftIO $ forkIO $+                     do runSysfsGpioIO $+                          withPin testPin2 $ \h ->+                            do udevScriptWait+                               setPinActiveLevel h ActiveHigh+                               setPinOutputMode h OutputDefault High+                               liftIO $ void $ takeMVar mvar+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                        putMVar mvar () -- synchronize finish+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveLow+                            setPinInterruptMode h FallingEdge+                            liftIO $ putMVar mvar ()+                            val1 <- pollPin h+                            val2 <- pollPin h+                            liftIO $ void $ takeMVar mvar -- synchronize finish+                            return (val1, val2))+                   `shouldReturn` (Low, Low)+              it "pollPin waits for level changes" $+                do mvar <- liftIO $ newEmptyMVar+                   void $ liftIO $ forkIO $+                     do runSysfsGpioIO $+                          withPin testPin2 $ \h ->+                            do udevScriptWait+                               setPinActiveLevel h ActiveHigh+                               setPinOutputMode h OutputDefault Low+                               liftIO $ void $ takeMVar mvar+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                        putMVar mvar () -- synchronize finish+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveLow+                            setPinInterruptMode h Level+                            liftIO $ putMVar mvar ()+                            val1 <- pollPin h+                            val2 <- pollPin h+                            val3 <- pollPin h+                            val4 <- pollPin h+                            liftIO $ void $ takeMVar mvar -- synchronize finish+                            return (val1, val2, val3, val4))+                   `shouldReturn` (Low, High, Low, High)+              it "pollPin can be disabled" $+                do mvar <- liftIO $ newEmptyMVar+                   runSysfsGpioIO+                     (withPin testPin1 $ \inPin ->+                        withPin testPin2 $ \outPin ->+                          do udevScriptWait+                             setPinInputMode inPin InputDefault+                             setPinActiveLevel inPin ActiveLow+                             setPinInterruptMode inPin Disabled+                             setPinActiveLevel outPin ActiveHigh+                             setPinOutputMode outPin OutputDefault Low+                             void $ liftIO $ forkIO $+                               do runSysfsGpioIO $+                                    do liftIO $ void $ takeMVar mvar+                                       liftIO $ threadDelay 500000+                                       void $ togglePin outPin -- ignored+                                       liftIO $ threadDelay 500000+                                       setPinInterruptMode inPin Level+                                       void $ togglePin outPin -- trigger+                                  putMVar mvar () -- synchronize finish+                             liftIO $ putMVar mvar ()+                             val <- pollPin inPin+                             liftIO $ void $ takeMVar mvar -- synchronize finish+                             return val)+                   `shouldReturn` High+         context "pollPinTimeout" $+           -- Note: if these tests fail, you might not have hooked pin+           -- P9-15 up to pin P8-15!+           do it "pollPinTimeout waits for rising edge" $+                do mvar <- liftIO $ newEmptyMVar+                   void $ liftIO $ forkIO $+                     do runSysfsGpioIO $+                          withPin testPin2 $ \h ->+                            do udevScriptWait+                               setPinActiveLevel h ActiveHigh+                               setPinOutputMode h OutputDefault High+                               liftIO $ void $ takeMVar mvar+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                        putMVar mvar () -- synchronize finish+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveHigh+                            setPinInterruptMode h RisingEdge+                            liftIO $ putMVar mvar ()+                            val1 <- pollPinTimeout h 10000000+                            val2 <- pollPinTimeout h 10000000+                            liftIO $ void $ takeMVar mvar -- synchronize finish+                            return (val1, val2))+                   `shouldReturn` (Just High, Just High)+              it "pollPinTimeout waits for falling edge" $+                do mvar <- liftIO $ newEmptyMVar+                   void $ liftIO $ forkIO $+                     do runSysfsGpioIO $+                          withPin testPin2 $ \h ->+                            do udevScriptWait+                               setPinActiveLevel h ActiveHigh+                               setPinOutputMode h OutputDefault Low+                               liftIO $ void $ takeMVar mvar+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                        putMVar mvar () -- synchronize finish+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveHigh+                            setPinInterruptMode h FallingEdge+                            liftIO $ putMVar mvar ()+                            val1 <- pollPinTimeout h 10000000+                            val2 <- pollPinTimeout h 10000000+                            liftIO $ void $ takeMVar mvar -- synchronize finish+                            return (val1, val2))+                   `shouldReturn` (Just Low, Just Low)+              it "pollPinTimeout waits for level changes" $+                do mvar <- liftIO $ newEmptyMVar+                   void $ liftIO $ forkIO $+                     do runSysfsGpioIO $+                          withPin testPin2 $ \h ->+                            do udevScriptWait+                               setPinActiveLevel h ActiveHigh+                               setPinOutputMode h OutputDefault High+                               liftIO $ void $ takeMVar mvar+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                        putMVar mvar () -- synchronize finish+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveHigh+                            setPinInterruptMode h Level+                            liftIO $ putMVar mvar ()+                            val1 <- pollPinTimeout h 10000000+                            val2 <- pollPinTimeout h 10000000+                            val3 <- pollPinTimeout h 10000000+                            val4 <- pollPinTimeout h 10000000+                            liftIO $ void $ takeMVar mvar -- synchronize finish+                            return (val1, val2, val3, val4))+                   `shouldReturn` (Just Low, Just High, Just Low, Just High)+              it "pollPinTimeout can be disabled" $+                do mvar <- liftIO $ newEmptyMVar+                   runSysfsGpioIO+                     (withPin testPin1 $ \inPin ->+                        withPin testPin2 $ \outPin ->+                          do udevScriptWait+                             setPinInputMode inPin InputDefault+                             setPinActiveLevel inPin ActiveHigh+                             setPinInterruptMode inPin Disabled+                             setPinActiveLevel outPin ActiveHigh+                             setPinOutputMode outPin OutputDefault Low+                             void $ liftIO $ forkIO $+                               do runSysfsGpioIO $+                                    do liftIO $ void $ takeMVar mvar+                                       liftIO $ threadDelay 500000+                                       void $ togglePin outPin -- ignored+                                       liftIO $ threadDelay 500000+                                       setPinInterruptMode inPin Level+                                       void $ togglePin outPin -- trigger+                                  putMVar mvar () -- synchronize finish+                             liftIO $ putMVar mvar ()+                             val <- pollPinTimeout inPin 10000000+                             liftIO $ void $ takeMVar mvar -- synchronize finish+                             return val)+                   `shouldReturn` Just Low+              it "pollPinTimeout actually times out" $+                 do mvar <- liftIO $ newEmptyMVar+                    runSysfsGpioIO+                      (withPin testPin1 $ \inPin ->+                         withPin testPin2 $ \outPin ->+                           do udevScriptWait+                              setPinInputMode inPin InputDefault+                              setPinActiveLevel inPin ActiveHigh+                              setPinInterruptMode inPin Disabled+                              setPinActiveLevel outPin ActiveHigh+                              setPinOutputMode outPin OutputDefault Low+                              void $ liftIO $ forkIO $+                                do runSysfsGpioIO $+                                     do liftIO $ void $ takeMVar mvar+                                        liftIO $ threadDelay 500000+                                        void $ togglePin outPin -- ignored+                                        liftIO $ threadDelay 500000+                                        void $ togglePin outPin -- ignored+                                   putMVar mvar () -- synchronize finish+                              liftIO $ putMVar mvar ()+                              val <- pollPinTimeout inPin 1000000+                              liftIO $ void $ takeMVar mvar -- synchronize finish+                              return val)+                    `shouldReturn` Nothing+              it "pollPinTimeout times out on output pins" $+                 do runSysfsGpioIO+                      (withPin testPin2 $ \outPin ->+                        do udevScriptWait+                           setPinActiveLevel outPin ActiveHigh+                           setPinOutputMode outPin OutputDefault Low+                           val <- pollPinTimeout outPin 1000000+                           return val)+                    `shouldReturn` Nothing+         context "pollPinTimeout with active-low logic" $+           -- Note: if these tests fail, you might not have hooked pin+           -- P9-15 up to pin P8-15!+           do it "pollPinTimeout waits for (active-low) rising edge" $+                do mvar <- liftIO $ newEmptyMVar+                   void $ liftIO $ forkIO $+                     do runSysfsGpioIO $+                          withPin testPin2 $ \h ->+                            do udevScriptWait+                               setPinActiveLevel h ActiveHigh+                               setPinOutputMode h OutputDefault Low+                               liftIO $ void $ takeMVar mvar+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                        putMVar mvar () -- synchronize finish+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveLow+                            setPinInterruptMode h RisingEdge+                            liftIO $ putMVar mvar ()+                            val1 <- pollPinTimeout h 10000000+                            val2 <- pollPinTimeout h 10000000+                            liftIO $ void $ takeMVar mvar -- synchronize finish+                            return (val1, val2))+                   `shouldReturn` (Just High, Just High)+              it "pollPinTimeout waits for (active-low) falling edge" $+                do mvar <- liftIO $ newEmptyMVar+                   void $ liftIO $ forkIO $+                     do runSysfsGpioIO $+                          withPin testPin2 $ \h ->+                            do udevScriptWait+                               setPinActiveLevel h ActiveHigh+                               setPinOutputMode h OutputDefault High+                               liftIO $ void $ takeMVar mvar+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                        putMVar mvar () -- synchronize finish+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveLow+                            setPinInterruptMode h FallingEdge+                            liftIO $ putMVar mvar ()+                            val1 <- pollPinTimeout h 10000000+                            val2 <- pollPinTimeout h 10000000+                            liftIO $ void $ takeMVar mvar -- synchronize finish+                            return (val1, val2))+                   `shouldReturn` (Just Low, Just Low)+              it "pollPinTimeout waits for level changes" $+                do mvar <- liftIO $ newEmptyMVar+                   void $ liftIO $ forkIO $+                     do runSysfsGpioIO $+                          withPin testPin2 $ \h ->+                            do udevScriptWait+                               setPinActiveLevel h ActiveHigh+                               setPinOutputMode h OutputDefault Low+                               liftIO $ void $ takeMVar mvar+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                               liftIO $ threadDelay 500000+                               void $ togglePin h -- trigger+                        putMVar mvar () -- synchronize finish+                   runSysfsGpioIO+                      (withPin testPin1 $ \h ->+                         do udevScriptWait+                            setPinInputMode h InputDefault+                            setPinActiveLevel h ActiveLow+                            setPinInterruptMode h Level+                            liftIO $ putMVar mvar ()+                            val1 <- pollPinTimeout h 10000000+                            val2 <- pollPinTimeout h 10000000+                            val3 <- pollPinTimeout h 10000000+                            val4 <- pollPinTimeout h 10000000+                            liftIO $ void $ takeMVar mvar -- synchronize finish+                            return (val1, val2, val3, val4))+                   `shouldReturn` (Just Low, Just High, Just Low, Just High)+              it "pollPinTimeout can be disabled" $+                do mvar <- liftIO $ newEmptyMVar+                   runSysfsGpioIO+                     (withPin testPin1 $ \inPin ->+                        withPin testPin2 $ \outPin ->+                          do udevScriptWait+                             setPinInputMode inPin InputDefault+                             setPinActiveLevel inPin ActiveLow+                             setPinInterruptMode inPin Disabled+                             setPinActiveLevel outPin ActiveHigh+                             setPinOutputMode outPin OutputDefault Low+                             void $ liftIO $ forkIO $+                               do runSysfsGpioIO $+                                    do liftIO $ void $ takeMVar mvar+                                       liftIO $ threadDelay 500000+                                       void $ togglePin outPin -- ignored+                                       liftIO $ threadDelay 500000+                                       setPinInterruptMode inPin Level+                                       void $ togglePin outPin -- trigger+                                  putMVar mvar () -- synchronize finish+                             liftIO $ putMVar mvar ()+                             val <- pollPinTimeout inPin 10000000+                             liftIO $ void $ takeMVar mvar -- synchronize finish+                             return val)+                   `shouldReturn` Just High+         context "Various NotExported exceptions" $+           do it "getPinDirection" $+                runSysfsGpioIO+                  (do h <- openPin testPin1+                      closePin h+                      v <- getPinDirection h+                      return v)+                  `shouldThrow` isNotExportedError+              it "getPinInputMode" $+                  runSysfsGpioIO+                    (do h <- openPin testPin1+                        closePin h+                        getPinInputMode h)+                    `shouldThrow` isNotExportedError+              it "setPinInputMode" $+                 runSysfsGpioIO+                   (do h <- openPin testPin1+                       closePin h+                       setPinInputMode h InputDefault)+                   `shouldThrow` isNotExportedError+              it "getPinOutputMode" $+                   runSysfsGpioIO+                     (do h <- openPin testPin1+                         closePin h+                         getPinOutputMode h)+                     `shouldThrow` isNotExportedError+              it "setPinOutputMode" $+                  runSysfsGpioIO+                    (do h <- openPin testPin1+                        closePin h+                        setPinOutputMode h OutputDefault Low)+                    `shouldThrow` isNotExportedError+              it "getPinInterruptMode" $+                runSysfsGpioIO+                  (do h <- openPin testPin1+                      closePin h+                      v <- getPinInterruptMode h+                      return v)+                  `shouldThrow` isNotExportedError+              it "setPinInterruptMode" $+                 runSysfsGpioIO+                   (do h <- openPin testPin1+                       closePin h+                       setPinInterruptMode h RisingEdge)+                   `shouldThrow` isNotExportedError+              it "getPinActiveLevel" $+                runSysfsGpioIO+                  (do h <- openPin testPin1+                      closePin h+                      v <- getPinActiveLevel h+                      return v)+                  `shouldThrow` isNotExportedError+              it "setPinActiveLevel" $+                runSysfsGpioIO+                  (do h <- openPin testPin1+                      closePin h+                      setPinActiveLevel h ActiveHigh)+                  `shouldThrow` isNotExportedError+              it "toggleActiveLevel" $+                 runSysfsGpioIO+                   (do h <- openPin testPin1+                       closePin h+                       v <- togglePinActiveLevel h+                       return v)+                   `shouldThrow` isNotExportedError+              it "readPin" $+                runSysfsGpioIO+                  (do h <- openPin testPin1+                      closePin h+                      v <- readPin h+                      return v)+                  `shouldThrow` isNotExportedError+              it "pollPin" $+                runSysfsGpioIO+                  (do h <- openPin testPin1+                      closePin h+                      v <- pollPin h+                      return v)+                  `shouldThrow` isNotExportedError+              it "pollPinTimeout" $+                runSysfsGpioIO+                  (do h <- openPin testPin1+                      closePin h+                      v <- pollPinTimeout h 100000+                      return v)+                  `shouldThrow` isNotExportedError+              it "writePin" $+                runSysfsGpioIO+                  (do h <- openPin testPin1+                      closePin h+                      writePin h High)+                  `shouldThrow` isNotExportedError+              it "togglePin" $+                runSysfsGpioIO+                  (do h <- openPin testPin1+                      closePin h+                      v <- togglePin h+                      return v)+                  `shouldThrow` isNotExportedError

@@ -0,0 +1,328 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-incomplete-uni-patterns #-}+{-# LANGUAGE OverloadedStrings #-}++module System.GPIO.Linux.Sysfs.MockInternalSpec (spec) where++import GHC.IO.Exception (IOErrorType(..))+import System.GPIO.Linux.Sysfs.Mock.Internal+import System.IO.Error (ioeGetErrorType, isAlreadyExistsError, isDoesNotExistError)+import Test.Hspec++isInvalidArgumentErrorType :: IOErrorType -> Bool+isInvalidArgumentErrorType InvalidArgument = True+isInvalidArgumentErrorType _ = False++isInvalidArgumentError :: IOError -> Bool+isInvalidArgumentError = isInvalidArgumentErrorType . ioeGetErrorType++isInappropriateTypeErrorType :: IOErrorType -> Bool+isInappropriateTypeErrorType InappropriateType = True+isInappropriateTypeErrorType _ = False++isInappropriateTypeError :: IOError -> Bool+isInappropriateTypeError = isInappropriateTypeErrorType . ioeGetErrorType++sysfsRoot :: Directory+sysfsRoot =+  directory "/"+            []+            [directory "sys"+                       []+                       [directory "class"+                                  []+                                  [directory "gpio"+                                             [File "export" Export+                                             ,File "unexport" Unexport]+                                             []]]]++parentName :: MockFSCrumb -> Name+parentName = _dirNodeName . _node++spec :: Spec+spec =+  let sysfsRootZ = MockFSZipper sysfsRoot []+  in+    do describe "cd" $ do++         context "relative paths" $ do++           it "can traverse downwards one directory at a time" $+             do let Right z1@(MockFSZipper dir1 (crumb1:_)) = cd "sys" sysfsRootZ+                dirName dir1 `shouldBe` "sys"+                parentName crumb1 `shouldBe` "/"+                let Right z2@(MockFSZipper dir2 (crumb2:_)) = cd "class" z1+                dirName dir2 `shouldBe` "class"+                parentName crumb2 `shouldBe` "sys"+                let Right (MockFSZipper dir3 (crumb3:_)) = cd "gpio" z2+                dirName dir3 `shouldBe` "gpio"+                parentName crumb3 `shouldBe` "class"++           it "can traverse downwards multiple directories at a time" $+             do let Right (MockFSZipper dir1 (crumb1:_)) = cd "sys/class/gpio" sysfsRootZ+                dirName dir1 `shouldBe` "gpio"+                parentName crumb1 `shouldBe` "class"++           it "fails when changing to a non-existent child" $+             do let Left result1 = cd "foobar" sysfsRootZ+                isDoesNotExistError result1 `shouldBe` True+                let Left result2 = (cd "sys/class" sysfsRootZ >>= cd "baz" )+                isDoesNotExistError result2 `shouldBe` True++           it "fails when changing to a non-existent grandchild" $+             do let Left result = cd "sys/class/foobar" sysfsRootZ+                isDoesNotExistError result `shouldBe` True++           it "fails when changing to a file name rather than a directory name" $+             do let Left result1 = (cd "sys/class/gpio" sysfsRootZ >>= cd "export")+                isInappropriateTypeError result1 `shouldBe` True+                let Left result2 = (cd "sys/class/gpio" sysfsRootZ >>= cd "export/foobar")+                isInappropriateTypeError result2 `shouldBe` True+                let Left result3 = cd "sys/class/gpio/unexport" sysfsRootZ+                isInappropriateTypeError result3 `shouldBe` True+                let Left result4 = cd "sys/class/gpio/unexport/baz" sysfsRootZ+                isInappropriateTypeError result4 `shouldBe` True++           it "'.' in paths" $+             do cd "sys/." sysfsRootZ `shouldBe` cd "sys" sysfsRootZ+                cd "sys/./class" sysfsRootZ `shouldBe` cd "sys/class" sysfsRootZ++           it "'..' in paths" $+             do cd "sys/.." sysfsRootZ `shouldBe` Right sysfsRootZ+                cd "sys/class/../class" sysfsRootZ `shouldBe` cd "sys/class" sysfsRootZ+                cd "sys/class/gpio/../../class" sysfsRootZ `shouldBe` cd "sys/../sys/class/../class/gpio/.." sysfsRootZ+                cd "sys/class/gpio/../../.." sysfsRootZ `shouldBe` Right sysfsRootZ++           it "'..' beyond root clamps to root" $+             do cd "sys/class/../../../.." sysfsRootZ `shouldBe` Right sysfsRootZ+                cd "../.." sysfsRootZ `shouldBe` Right sysfsRootZ++         context "absolute paths" $ do+           it "can traverse downwards one directory at a time" $+             do let Right z1@(MockFSZipper dir1 (crumb1:_)) = cd "/sys" sysfsRootZ+                dirName dir1 `shouldBe` "sys"+                parentName crumb1 `shouldBe` "/"+                let Right z2@(MockFSZipper dir2 (crumb2:_)) = cd "class" z1+                dirName dir2 `shouldBe` "class"+                parentName crumb2 `shouldBe` "sys"+                let Right (MockFSZipper dir3 (crumb3:_)) = cd "gpio" z2+                dirName dir3 `shouldBe` "gpio"+                parentName crumb3 `shouldBe` "class"+           it "can traverse downwards multiple directories at a time" $+             do let Right (MockFSZipper dir1 (crumb1:_)) = cd "/sys/class/gpio" sysfsRootZ+                dirName dir1 `shouldBe` "gpio"+                parentName crumb1 `shouldBe` "class"+           it "fails when changing to a non-existent child" $+             do let Left result = cd "/foobar" sysfsRootZ+                isDoesNotExistError result `shouldBe` True+           it "fails when changing to a non-existent grandchild" $+             do let Left result = cd "/sys/class/foobar" sysfsRootZ+                isDoesNotExistError result `shouldBe` True+           it "fails when changing to a file name rather than a directory name" $+             do let Left result1 = cd "/sys/class/gpio/export" sysfsRootZ+                isInappropriateTypeError result1 `shouldBe` True+                let Left result2 = cd "/sys/class/gpio/unexport/baz" sysfsRootZ+                isInappropriateTypeError result2 `shouldBe` True++           it "cd / is root" $+             cd "/" sysfsRootZ `shouldBe` Right sysfsRootZ++           it "cd / from deeper starts at root" $ do+             (cd "/sys/class/gpio" sysfsRootZ >>= cd "/") `shouldBe` Right sysfsRootZ+             (cd "/sys/class/gpio" sysfsRootZ >>= cd "/sys/class") `shouldBe` cd "/sys/class" sysfsRootZ++           it "'.' in paths" $+             do cd "/sys/." sysfsRootZ `shouldBe` cd "/sys" sysfsRootZ+                cd "/sys/./class" sysfsRootZ `shouldBe` cd "/sys/class" sysfsRootZ+           it "'..' in paths" $+             do cd "/sys/.." sysfsRootZ `shouldBe` Right sysfsRootZ+                cd "/sys/class/../class" sysfsRootZ `shouldBe` cd "/sys/class" sysfsRootZ+                cd "/sys/class/gpio/../../class" sysfsRootZ `shouldBe` cd "/sys/../sys/class/../class/gpio/.." sysfsRootZ+                cd "/sys/class/gpio/../../.." sysfsRootZ `shouldBe` Right sysfsRootZ+           it "'..' beyond root clamps to root" $+             do cd "/sys/class/../../../.." sysfsRootZ `shouldBe` Right sysfsRootZ+                cd "/../.." sysfsRootZ `shouldBe` Right sysfsRootZ++         context "absolute and relative paths" $ do+           it "produce the same result when they lead to the same directory" $+             do cd "sys/class/gpio" sysfsRootZ `shouldBe` cd "/sys/class/gpio" sysfsRootZ+                cd "sys/class/gpio/.." sysfsRootZ `shouldBe` cd "/sys/class/gpio/.." sysfsRootZ+                cd "sys/class/gpio/../../." sysfsRootZ `shouldBe` cd "/sys/class/gpio/../../." sysfsRootZ+                cd "sys/class/.././class/../../sys" sysfsRootZ `shouldBe` cd "/sys/../sys/class/./gpio/../.." sysfsRootZ++       describe "mkdir" $+         do it "creates a subdirectory in the current directory" $+              do let Right z1@(MockFSZipper dir1 crumb1) = mkdir "xyzzy" sysfsRootZ+                 dirName dir1 `shouldBe` "/"+                 crumb1 `shouldBe` []+                 let Right (MockFSZipper dir2 (crumb2:_)) = cd "xyzzy" z1+                 dirName dir2 `shouldBe` "xyzzy"+                 parentName crumb2 `shouldBe` "/"++            it "can create multiple subdirectories in the same directory" $+              do let Right z1@(MockFSZipper dir1 crumb1) = mkdir "xyzzy" sysfsRootZ+                 dirName dir1 `shouldBe` "/"+                 crumb1 `shouldBe` []+                 let Right z2@(MockFSZipper dir2 crumb2) = mkdir "plugh" z1+                 dirName dir2 `shouldBe` "/"+                 crumb2 `shouldBe` []+                 let Right z3@(MockFSZipper dir3 (crumb3:_)) = cd "xyzzy" z2+                 dirName dir3 `shouldBe` "xyzzy"+                 parentName crumb3 `shouldBe` "/"+                 let Right (MockFSZipper dir4 (crumb4:_)) = cd "../plugh" z3+                 dirName dir4 `shouldBe` "plugh"+                 parentName crumb4 `shouldBe` "/"++            it "works when nested" $+              do let Right (MockFSZipper dir (crumb:_)) = mkdir "abc" sysfsRootZ >>= cd "/abc" >>= mkdir "def" >>= cd "/abc/def"+                 dirName dir `shouldBe` "def"+                 parentName crumb `shouldBe` "abc"++            it "fails when a subdir with the same name already exists" $+              do let Left result = mkdir "sys" sysfsRootZ+                 isAlreadyExistsError result `shouldBe` True++            it "fails when a file with the same name already exists" $+              do let Left result = (cd "/sys/class/gpio" sysfsRootZ >>= mkdir "export")+                 isAlreadyExistsError result `shouldBe` True++            it "fails with an invalid name" $+              do let Left result = mkdir "" sysfsRootZ+                 isInvalidArgumentError result `shouldBe` True++            it "fails when the name contains a '/'" $+              do let Left result1 = mkdir "/abc" sysfsRootZ+                 isInvalidArgumentError result1 `shouldBe` True+                 let Left result2 = mkdir "sys/foobar" sysfsRootZ+                 isInvalidArgumentError result2 `shouldBe` True++       describe "mkfile" $+         do it "creates a file in the current directory when clobber is False" $+              do let Right z1 = cd "/sys/class/gpio" sysfsRootZ+                 let Right (MockFSZipper dir2 (crumb2:_)) = mkfile "gpio1" (Const ["Hey!", "This is gpio1"]) False z1+                 dirName dir2 `shouldBe` "gpio"+                 parentName crumb2 `shouldBe` "class"+                 let file:rest = files dir2+                 _fileName file `shouldBe` "gpio1"+                 _fileType file `shouldBe` (Const ["Hey!", "This is gpio1"])+                 rest `shouldBe` [File {_fileName = "export", _fileType = Export},File {_fileName = "unexport", _fileType = Unexport}]++            it "creates a file in the current directory when clobber is True" $+              do let Right z1 = cd "/sys/class/gpio" sysfsRootZ+                 let Right (MockFSZipper dir2 (crumb2:_)) = mkfile "gpio1" (Const ["Hey!", "This is gpio1"]) True z1+                 dirName dir2 `shouldBe` "gpio"+                 parentName crumb2 `shouldBe` "class"+                 let file:rest = files dir2+                 _fileName file `shouldBe` "gpio1"+                 _fileType file `shouldBe` (Const ["Hey!", "This is gpio1"])+                 rest `shouldBe` [File {_fileName = "export", _fileType = Export},File {_fileName = "unexport", _fileType = Unexport}]++            it "fails when a subdir with the same name already exists" $ do+              let Left result1 = mkfile "sys" (Const []) True sysfsRootZ+              isAlreadyExistsError result1 `shouldBe` True+              let Left result2 = mkfile "sys" (Const []) False sysfsRootZ+              isAlreadyExistsError result2 `shouldBe` True++            it "fails when a file with the same name already exists and clobber is False" $+              do let Left result = (cd "/sys/class/gpio" sysfsRootZ >>= mkfile "export" (Const []) False)+                 isAlreadyExistsError result `shouldBe` True++            it "overwrites an existing file's contents when a file with the same name already exists and clobber is True" $+              do let Right z1 = cd "/sys/class/gpio" sysfsRootZ+                 let Right z2 = mkfile "gpio1" (Const ["Hey!", "This is gpio1"]) False z1+                 let Right (MockFSZipper dir3 (crumb3:_)) = mkfile "gpio1" (Const ["Hey!", "Now I'm gpio1"]) True z2+                 dirName dir3 `shouldBe` "gpio"+                 parentName crumb3 `shouldBe` "class"+                 let file:rest = files dir3+                 _fileName file `shouldBe` "gpio1"+                 _fileType file `shouldBe` (Const ["Hey!", "Now I'm gpio1"])+                 rest `shouldBe` [File {_fileName = "export", _fileType = Export},File {_fileName = "unexport", _fileType = Unexport}]++            it "fails with an invalid name" $ do+              let Left result1 = mkfile "" (Const []) False sysfsRootZ+              isInvalidArgumentError result1 `shouldBe` True+              let Left result2 = mkfile "" (Const []) True sysfsRootZ+              isInvalidArgumentError result2 `shouldBe` True++            it "fails when the name contains a '/'" $+              do let Left result1 = mkfile "/abc" (Const []) False sysfsRootZ+                 isInvalidArgumentError result1 `shouldBe` True+                 let Left result2 = mkfile "/abc" (Const []) True sysfsRootZ+                 isInvalidArgumentError result2 `shouldBe` True+                 let Left result3 = mkfile "sys/foobar" (Const []) False sysfsRootZ+                 isInvalidArgumentError result3 `shouldBe` True+                 let Left result4 = mkfile "sys/foobar" (Const []) True sysfsRootZ+                 isInvalidArgumentError result4 `shouldBe` True++       describe "findFile" $+         do it "finds files in the current directory" $+              do let Right z1@(MockFSZipper dir1 _) = cd "/sys/class/gpio" sysfsRootZ+                 findFile "export" dir1 `shouldBe` (Just Export)+                 findFile "unexport" dir1 `shouldBe` (Just Unexport)+                 let Right (MockFSZipper dir2 _) = mkfile "gpio1" (Const ["Hey!", "This is gpio1"]) False z1+                 findFile "gpio1" dir2 `shouldBe` (Just ((Const ["Hey!", "This is gpio1"])))+            it "doesn't find subdirectories in the current directory" $+              do let Right (MockFSZipper dir1 _) = cd "/sys/class" sysfsRootZ+                 findFile "gpio" dir1 `shouldBe` Nothing+            it "returns failure on non-existent files" $+              do let Right (MockFSZipper dir1 _) = cd "/sys/class" sysfsRootZ+                 findFile "foobar" dir1 `shouldBe` Nothing+                 findFile "export" dir1 `shouldBe` Nothing+            it "doesn't find files in subdirectories of the current directory" $+              do let Right (MockFSZipper dir1 _) = cd "/sys/class" sysfsRootZ+                 findFile "gpio/export" dir1 `shouldBe` Nothing++       describe "rmdir" $+         do it "removes a subdirectory of the current directory" $+              do let Right z1 = cd "/sys" sysfsRootZ >>= mkdir "xyzzy" >>= mkdir "plugh"+                 let Right z2@(MockFSZipper dir2 (crumb2:_)) = rmdir "xyzzy" z1+                 dirName dir2 `shouldBe` "sys"+                 parentName crumb2 `shouldBe` "/"+                 let Right (MockFSZipper dir3 (crumb3:_)) = rmdir "plugh" z2+                 dirName dir3 `shouldBe` "sys"+                 parentName crumb3 `shouldBe` "/"++            it "fails when no subdir with the name exists" $+              do let Left result = rmdir "foo" sysfsRootZ+                 isDoesNotExistError result `shouldBe` True++            it "fails when a file is named" $+              do let Left result = (cd "/sys/class/gpio" sysfsRootZ >>= rmdir "export")+                 isInappropriateTypeError result `shouldBe` True++            it "fails when the name contains a '/'" $+              do let Left result1 = rmdir "/sys" sysfsRootZ+                 isDoesNotExistError result1 `shouldBe` True+                 let Left result2 = rmdir "sys/class" sysfsRootZ+                 isDoesNotExistError result2 `shouldBe` True++       describe "rmfile" $+         do it "removes a file in the current directory" $+              do let Right z1 = cd "/sys" sysfsRootZ >>= mkfile "abc" (Const []) False >>= mkfile "def" (Const []) False+                 let Right z2@(MockFSZipper dir2 (crumb2:_)) = rmfile "abc" z1+                 dirName dir2 `shouldBe` "sys"+                 parentName crumb2 `shouldBe` "/"+                 files dir2 `shouldBe` [File {_fileName = "def", _fileType = (Const [])}]+                 let Right (MockFSZipper dir3 (crumb3:_)) = rmfile "def" z2+                 dirName dir3 `shouldBe` "sys"+                 parentName crumb3 `shouldBe` "/"+                 files dir3 `shouldBe` []++            it "fails when no file with the name exists" $+              do let Left result = rmfile "foo" sysfsRootZ+                 isDoesNotExistError result `shouldBe` True++            it "fails when a directory is named" $+              do let Left result = (cd "/sys/class" sysfsRootZ >>= rmfile "gpio")+                 isInappropriateTypeError result `shouldBe` True++            it "fails when the name contains a '/'" $+              do let Left result = rmfile "/sys/class/gpio/export" sysfsRootZ+                 isDoesNotExistError result `shouldBe` True++       describe "pathFromRoot" $+         do it "returns the path from the current directory to the root directory" $+              do pathFromRoot sysfsRootZ `shouldBe` "/"+                 let Right z1 = cd "/sys/class/gpio" sysfsRootZ+                 pathFromRoot z1 `shouldBe` "/sys/class/gpio"+                 let Right z2 = cd "/sys/class/gpio/../../class" sysfsRootZ+                 pathFromRoot z2 `shouldBe` "/sys/class"

@@ -0,0 +1,138 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-incomplete-uni-patterns #-}+{-# LANGUAGE OverloadedStrings #-}++module System.GPIO.Linux.Sysfs.MockSpec (spec) where++import Prelude hiding (readFile, writeFile)+import Control.Exception (fromException)+import Data.List (sort)+import GHC.IO.Exception (IOErrorType(..))+import System.GPIO.Linux.Sysfs.Mock+import System.GPIO.Types (Pin(..), PinValue(..))+import System.IO.Error (ioeGetErrorType, isDoesNotExistError, isPermissionError)+import Test.Hspec++isInappropriateTypeErrorType :: IOErrorType -> Bool+isInappropriateTypeErrorType InappropriateType = True+isInappropriateTypeErrorType _ = False++isInappropriateTypeError :: IOError -> Bool+isInappropriateTypeError = isInappropriateTypeErrorType . ioeGetErrorType++evalSysfsMock' :: SysfsMock a -> MockWorld -> [MockGpioChip] -> Either (Maybe IOError) a+evalSysfsMock' a w c = either (Left . fromException) Right $ evalSysfsMock a w c++evalSysfsMockME :: SysfsMock a -> MockWorld -> [MockGpioChip] -> Either (Maybe MockFSException) a+evalSysfsMockME a w c = either (Left . fromException) Right $ evalSysfsMock a w c++execSysfsMock' :: SysfsMock a -> MockWorld -> [MockGpioChip] -> Either (Maybe IOError) MockWorld+execSysfsMock' a w c = either (Left . fromException) Right $ execSysfsMock a w c++spec :: Spec+spec =+  do+    describe "MockPinState" $ do+      it "logicalValue returns the correct pin value" $+        let pinState = defaultMockPinState {_value = Low, _activeLow = False}+        in do+          logicalValue pinState `shouldBe` Low+          logicalValue (pinState {_value = High}) `shouldBe` High+          logicalValue (pinState {_activeLow = True}) `shouldBe` High+          logicalValue (pinState {_value = High, _activeLow = True}) `shouldBe` Low+      it "setLogicalValue sets the correct pin value" $+        let pinState = defaultMockPinState {_value = Low, _activeLow = False}+            activeLowPinState = defaultMockPinState {_value = Low, _activeLow = True}+        in do+          setLogicalValue Low pinState `shouldBe` pinState+          setLogicalValue High pinState `shouldBe` pinState {_value = High}+          setLogicalValue Low activeLowPinState `shouldBe` activeLowPinState {_value = High}+          setLogicalValue High activeLowPinState `shouldBe` activeLowPinState {_value = Low}++    describe "SysfsMockT" $ do++      context "doesDirectoryExist" $ do+        it "relative paths are relative to the initial zipper's working directory" $ do+          evalSysfsMock' (doesDirectoryExist "sys/class/gpio") initialMockWorld [] `shouldBe` Right True+        it "absolute paths work regardless of the initial zipper's working directory" $ do+          evalSysfsMock' (doesDirectoryExist "/sys/class/gpio") initialMockWorld [] `shouldBe` Right True+        it "doesn't change the initial zipper's state" $ do+          execSysfsMock' (doesDirectoryExist "/sys/class/gpio") initialMockWorld [] `shouldBe` Right initialMockWorld+        it "returns False on files" $ do+          evalSysfsMock' (doesDirectoryExist "/sys/class/gpio/export") initialMockWorld [] `shouldBe` Right False+        it "returns False on non-existent names" $ do+          evalSysfsMock' (doesDirectoryExist "/sys/class/foobar") initialMockWorld [] `shouldBe` Right False++      context "doesFileExist" $ do+        it "relative paths are relative to the initial zipper's working directory" $ do+          evalSysfsMock' (doesFileExist "sys/class/gpio/export") initialMockWorld [] `shouldBe` Right True+        it "absolute paths work regardless of the initial zipper's working directory" $ do+          evalSysfsMock' (doesFileExist "/sys/class/gpio/export") initialMockWorld [] `shouldBe` Right True+        it "doesn't change the initial zipper's state" $ do+          execSysfsMock' (doesFileExist "/sys/class/gpio/export") initialMockWorld [] `shouldBe` Right initialMockWorld+        it "returns False on directories" $ do+          evalSysfsMock' (doesFileExist "/sys/class/gpio") initialMockWorld [] `shouldBe` Right False+        it "returns False on non-existent names" $ do+          evalSysfsMock' (doesFileExist "/sys/class/foobar") initialMockWorld [] `shouldBe` Right False++      context "getDirectoryContents" $ do+        it "relative paths are relative to the initial zipper's working directory" $ do+          fmap sort (evalSysfsMock' (getDirectoryContents "sys/class") initialMockWorld []) `shouldBe` Right ["gpio"]+          fmap sort (evalSysfsMock' (getDirectoryContents "sys/class/gpio") initialMockWorld []) `shouldBe` (Right $ sort ["export", "unexport"])+        it "absolute paths work regardless of the initial zipper's working directory" $ do+          fmap sort (evalSysfsMock' (getDirectoryContents "/sys/class") initialMockWorld []) `shouldBe` Right ["gpio"]+          fmap sort (evalSysfsMock' (getDirectoryContents "/sys/class/gpio") initialMockWorld []) `shouldBe` (Right $ sort ["export", "unexport"])+        it "doesn't change the initial zipper's state" $ do+          execSysfsMock' (getDirectoryContents "/sys/class/gpio") initialMockWorld [] `shouldBe` Right initialMockWorld+        it "returns failure on files" $ do+          do let Left (Just result) = evalSysfsMock' (getDirectoryContents "/sys/class/gpio/export") initialMockWorld []+             isInappropriateTypeError result `shouldBe` True+        it "returns failure on non-existent names" $ do+          do let Left (Just result) = evalSysfsMock' (getDirectoryContents "/sys/class/foobar") initialMockWorld []+             isDoesNotExistError result `shouldBe` True++      context "readFile" $ do+        -- Note: most interesting cases are already checked by the+        -- tests in 'SysfsGpioMockSpec.hs' and it would be a bit silly+        -- to try to test them here due to the amount of setup+        -- required to get the filesystem into the necessary state.+        -- (We would basically end up rewriting large chunks of the+        -- mock GPIO code.)+        it "works with 'constant' files" $+          let chip0 = MockGpioChip "chip0" 0 (replicate 16 defaultMockPinState)+          in evalSysfsMock' (readFile "/sys/class/gpio/gpiochip0/base") initialMockWorld [chip0] `shouldBe` Right "0\n"+        it "fails on /sys/class/gpio/export" $+          do let Left (Just result) = evalSysfsMock' (readFile "/sys/class/gpio/export") initialMockWorld []+             isPermissionError result `shouldBe` True+        it "fails on /sys/class/gpio/unexport" $+          do let Left (Just result) = evalSysfsMock' (readFile "/sys/class/gpio/unexport") initialMockWorld []+             isPermissionError result `shouldBe` True+        it "fails on non-existent file" $+          do let Left (Just result) = evalSysfsMock' (readFile "/sys/class/gpio/foo") initialMockWorld []+             isDoesNotExistError result `shouldBe` True+        it "fails on a directory" $+          do let Left (Just result) = evalSysfsMock' (readFile "/sys/class/gpio") initialMockWorld []+             isInappropriateTypeError result `shouldBe` True++      context "writeFile" $+        it "does the right thing" $+          pendingWith "Not implemented" -- See notes for 'readFile'+                                        -- above.++      context "runSysfsMockT" $ do+        let chip0 = MockGpioChip "chip0" 0 (replicate 16 defaultMockPinState)+            chip16 = MockGpioChip "xyz" 16 (replicate 32 defaultMockPinState)+            chip64 = MockGpioChip "abc" 64 (replicate 16 defaultMockPinState)+            invalidChip32 = MockGpioChip "invalid" 32 (replicate 16 defaultMockPinState)+        it "creates the specified gpiochip directories" $ do+          fmap sort (evalSysfsMock' (getDirectoryContents "/sys/class/gpio") initialMockWorld [chip0, chip16, chip64]) `shouldBe` Right ["export", "gpiochip0", "gpiochip16", "gpiochip64", "unexport"]+          evalSysfsMock' (readFile "/sys/class/gpio/gpiochip0/base") initialMockWorld [chip0, chip16, chip64] `shouldBe` Right "0\n"+          evalSysfsMock' (readFile "/sys/class/gpio/gpiochip0/ngpio") initialMockWorld [chip0, chip16, chip64] `shouldBe` Right "16\n"+          evalSysfsMock' (readFile "/sys/class/gpio/gpiochip0/label") initialMockWorld [chip0, chip16, chip64] `shouldBe` Right "chip0\n"+          evalSysfsMock' (readFile "/sys/class/gpio/gpiochip16/base") initialMockWorld [chip0, chip16, chip64] `shouldBe` Right "16\n"+          evalSysfsMock' (readFile "/sys/class/gpio/gpiochip16/ngpio") initialMockWorld [chip0, chip16, chip64] `shouldBe` Right "32\n"+          evalSysfsMock' (readFile "/sys/class/gpio/gpiochip16/label") initialMockWorld [chip0, chip16, chip64] `shouldBe` Right "xyz\n"+          evalSysfsMock' (readFile "/sys/class/gpio/gpiochip64/base") initialMockWorld [chip0, chip16, chip64] `shouldBe` Right "64\n"+          evalSysfsMock' (readFile "/sys/class/gpio/gpiochip64/ngpio") initialMockWorld [chip0, chip16, chip64] `shouldBe` Right "16\n"+          evalSysfsMock' (readFile "/sys/class/gpio/gpiochip64/label") initialMockWorld [chip0, chip16, chip64] `shouldBe` Right "abc\n"+        it "fails when MockGpioChips overlap" $ do+          evalSysfsMockME (readFile "/sys/class/gpio/gpiochip16/ngpio") initialMockWorld [chip0, chip16, invalidChip32] `shouldBe` Left (Just $ GpioChipOverlap $ Pin 47)

@@ -0,0 +1,879 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-incomplete-uni-patterns #-}+{-# LANGUAGE OverloadedStrings #-}++module System.GPIO.Linux.Sysfs.SysfsGpioMockSpec (spec) where++import Control.Exception (fromException)+import Control.Monad (void)+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}

@@ -0,0 +1,142 @@+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+{-# LANGUAGE CPP #-}++#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif++module System.GPIO.TypesSpec (spec) where++import System.GPIO.Types++import Data.Bits+import Test.Hspec+import Test.QuickCheck (property)++-- Test all our hand-derived instances and functions.++-- PinValue mimics Bool with respect to Bits and FiniteBits.+--+ib2v :: (Int -> Bool) -> Int -> PinValue+ib2v f n = boolToValue $ f n++bi2v :: (Bool -> Int) -> PinValue -> Int+bi2v f a = f (valueToBool a)++bb2v :: (Bool -> Bool) -> PinValue -> PinValue+bb2v f a = boolToValue $ f (valueToBool a)++bbb2v :: (Bool -> Bool -> Bool) -> PinValue -> PinValue -> PinValue+bbb2v f a b = boolToValue $ f (valueToBool a) (valueToBool b)++bib2v :: (Bool -> Int -> Bool) -> PinValue -> Int -> PinValue+bib2v f a n = boolToValue $ f (valueToBool a) n++#if MIN_VERSION_base(4,8,0)+newBase :: Spec+newBase =+  do context "implements the new base-4.8.0.0 FiniteBits typeclass methods" $+       do it "countLeadingZeros" $ property $+            \a -> countLeadingZeros a == bi2v countLeadingZeros a+          it "countTrailingZeros" $ property $+            \a -> countTrailingZeros a == bi2v countTrailingZeros a+#else+newBase :: Spec+newBase = return ()+#endif++spec :: Spec+spec =+  do describe "Pin" $+       do it "pinNumber" $ property $+            \p@(Pin n) -> n == pinNumber p++     describe "PinDirection" $+       do it "invertDirection" $+            invertDirection In == Out+              && invertDirection Out == In++     describe "PinValue" $+       do it "invertValue" $ property $+            \a -> invertValue a == complement a++          it "valueToBool" $+            valueToBool Low == False+              && valueToBool High == True++          it "boolToValue" $+            boolToValue False == Low+              && boolToValue True == High++          context "implements the Bits typeclass" $+           do it "(.&.)" $ property $+                \a b -> a .&. b == bbb2v (.&.) a b++              it "(.|.)" $ property $+                \a b -> a .|. b == bbb2v (.|.) a b++              it "xor" $ property $+                \a b -> a `xor` b == bbb2v xor a b++              it "complement" $ property $+                \a -> complement a == bb2v complement a++              it "shift" $ property $+                \a n -> a `shift` n == bib2v shift a n++              it "rotate" $ property $+                \a n -> a `rotate` n == bib2v rotate a n++              it "zeroBits" $ property $+                (zeroBits :: PinValue) == boolToValue (zeroBits:: Bool)++              it "bit" $ property $+                \n -> bit n == ib2v bit n++              it "setBit" $ property $+                \a n -> a `setBit` n == bib2v setBit a n++              it "clearBit" $ property $+                \a n -> a `clearBit` n == bib2v clearBit a n++              it "complementBit" $ property $+                \a n -> a `complementBit` n == bib2v complementBit a n++              it "testBit" $ property $+                \a n -> testBit a n == testBit (valueToBool a) n++              it "bitSizeMaybe" $ property $+                \a -> bitSizeMaybe a == bitSizeMaybe (valueToBool a)++              it "bitSize" $ property $+                \a -> bitSize a == bitSize (valueToBool a)++              it "isSigned" $ property $+                \a -> isSigned a == isSigned (valueToBool a)++              it "shiftL" $ property $+                \a n -> a `shiftL` n == bib2v shiftL a n++              it "unsafeShiftL" $ property $+                \a n -> a `unsafeShiftL` n == bib2v unsafeShiftL a n++              it "shiftR" $ property $+                \a n -> a `shiftR` n == bib2v shiftR a n++              it "unsafeShiftR" $ property $+                \a n -> a `unsafeShiftR` n == bib2v unsafeShiftR a n++              it "rotateL" $ property $+                \a n -> a `rotateL` n == bib2v rotateL a n++              it "rotateR" $ property $+                \a n -> a `rotateR` n == bib2v rotateR a n++              it "popCount" $ property $+                \a -> popCount a == popCount (valueToBool a)++          context "implements the FiniteBits typeclass" $+            do it "finiteBitSize" $ property $+                 \a -> finiteBitSize a == bi2v finiteBitSize a++               newBase