module System.GPIO
( Pin(..)
, fromInt
, ActivePin
, Value(..)
, Direction
, initReaderPin
, initWriterPin
, readPin
, writePin
, reattachToReaderPin
, reattachToWriterPin
, closePin
) where
import Control.Exception (SomeException (..))
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Maybe
import Safe
import System.Directory
import System.GPIO.Path
import System.GPIO.Types
data PinException
= InitPinException Pin String
| SetDirectionException Pin Direction String
| ReadPinException Pin String
| WritePinException Pin Value String
| ReattachPinException Pin String
| ClosePinException Pin String
deriving (Show)
instance Exception PinException
initReaderPin :: (MonadCatch m, MonadIO m) => Pin -> m (ActivePin 'In)
initReaderPin = initPin . ReaderPin
initWriterPin :: (MonadCatch m, MonadIO m) => Pin -> m (ActivePin 'Out)
initWriterPin = initPin . WriterPin
initPin :: (MonadCatch m, MonadIO m) => ActivePin a -> m (ActivePin a)
initPin pin = do
withVerboseError (InitPinException (unpin pin)) $
writeFileM exportPath (toData $ unpin pin)
withVerboseError (SetDirectionException (unpin pin) (direction pin)) $
writeFileM (directionPath $ unpin pin) (toData (direction pin))
return pin
readPin :: (MonadCatch m, MonadIO m) => ActivePin a -> m Value
readPin pin = do
x <- readFirstLine $ valuePath (unpin pin)
case fromData x of
Right v -> return v
Left e -> throwM $ ReadPinException (unpin pin) e
writePin :: (MonadCatch m, MonadIO m) => Value -> ActivePin 'Out -> m ()
writePin value pin = withVerboseError (WritePinException (unpin pin) value)
$ writeFileM (valuePath $ unpin pin) (toData value)
reattachToReaderPin :: (MonadCatch m, MonadIO m) => Pin -> m (ActivePin 'In)
reattachToReaderPin = reattachToPin . ReaderPin
reattachToWriterPin :: (MonadCatch m, MonadIO m) => Pin -> m (ActivePin 'Out)
reattachToWriterPin = reattachToPin . WriterPin
reattachToPin :: (MonadCatch m, MonadIO m) => ActivePin a -> m (ActivePin a)
reattachToPin pin = do
let err = ReattachPinException (unpin pin)
exists <- liftIO $ doesFileExist (directionPath (unpin pin))
unless exists $ throwM (err "Pin was never initialized")
v <- fromData <$> readFirstLine (directionPath (unpin pin))
dir <- either (throwM . err) return v
unless (dir == direction pin) $ throwM (err "Attempting to reattach to pin in wrong direction")
return pin
closePin :: (MonadCatch m, MonadIO m) => ActivePin a -> m ()
closePin pin = withVerboseError (ClosePinException (unpin pin))
$ writeFileM unexportPath (toData $ unpin pin)
withVerboseError :: MonadCatch m => (String -> PinException) -> m () -> m ()
withVerboseError pinException = handle $ \(e :: SomeException) -> throwM $ pinException (show e)
writeFileM :: MonadIO m => FilePath -> String -> m ()
writeFileM fp = liftIO . writeFile fp
readFileM :: MonadIO m => FilePath -> m String
readFileM = liftIO . readFile
readFirstLine :: MonadIO m => FilePath -> m String
readFirstLine = fmap (fromMaybe mempty . headMay . lines) . readFileM