MockSpec.hs

{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-incomplete-uni-patterns #-}
{-# LANGUAGE OverloadedStrings #-}

module Test.System.GPIO.Linux.Sysfs.MockSpec (spec) where

import Protolude hiding (readFile, writeFile)
import GHC.IO.Exception (IOErrorType(..))
import System.GPIO.Linux.Sysfs.Mock
import System.GPIO.Types (Pin(..), PinValue(..))
import System.IO.Error
       (IOError, 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)