packages feed

gpio 0.1.0.2 → 0.1.0.3

raw patch · 9 files changed

+332/−275 lines, 9 filesdep +directorydep +exceptionsdep +safedep −basic-preludedep −string-conversionsdep ~base

Dependencies added: directory, exceptions, safe

Dependencies removed: basic-prelude, string-conversions

Dependency ranges changed: base

Files

+ README.md view
@@ -0,0 +1,14 @@+Haskell GPIO interface, designed specifically for the RaspberryPi.++This library also ships with an executable for directly running gpio commands. Note: when using the executable there are less guarantees about the current state of a pin. For example, when using the library we can be sure that an `ActivePin 'Out` has already been initialized and configured for writing values, when using the executable we are less sure, and therefore errors might occur.+++Note: this package has limited functionality, might be buggy and is not optimized. It works for simple read/write operations on a few pre-defined pins, but still needs a lot more testing.++TODO:+  * Remove `runLineHack` when reading GPIO value files.+  * Optimize file reading to only look at first char.+  * Support other pin modes (in/out/up/down/pwm)+  * Support edges+  * Look into GPIO supported file watching+  * Add all pin numbers
+ exec/Main.hs view
@@ -0,0 +1,44 @@+module Main (main) where++import Control.Monad+import Options.Generic++import System.GPIO++data Command+    = Init Int String+    | Read Int String+    | Write Int String+    | Close Int String+  deriving (Generic, Show)++instance ParseRecord Command++main :: IO ()+main = getRecord "GPIO" >>= \case+    Init x "in"   -> void (initReaderPin (getPin x))+    Init x "out"  -> void (initWriterPin (getPin x))+    Init _ _      -> error "Usage error: use 'in' or 'out' for export direction."++    Read x "in"   -> reattachToReaderPin (getPin x) >>= readPin >>= print+    Read x "out"  -> reattachToWriterPin (getPin x) >>= readPin >>= print+    Read _ _      -> error "Usage error: use 'in' or 'out' for export direction."++    Write x "hi"  -> reattachToWriterPin (getPin x) >>= writePin HI+    Write x "lo"  -> reattachToWriterPin (getPin x) >>= writePin LO+    Write _ _     -> error "Usage error: use 'hi' or 'lo' for write value."++    Close x "in"  -> reattachToReaderPin (getPin x) >>= closePin+    Close x "out" -> reattachToWriterPin (getPin x) >>= closePin+    Close _ _     -> error "Usage error: use 'in' or 'out' for export direction."+  where+    getPin = throwLeft . parsePin+++parsePin :: Int -> Either String Pin+parsePin x = case fromInt x of+    Nothing -> Left ("Usage error: could not parse pin value from integer: " ++ show x)+    Just p  -> Right p++throwLeft :: Either String a -> a+throwLeft = either error id
gpio.cabal view
@@ -1,45 +1,56 @@-name:                gpio-version:             0.1.0.2-synopsis:            Haskell GPIO interface, designed specifically for the RaspberryPi.-description:         Please see README.md-homepage:            http://github.com/tgolson/gpio-license:             BSD3-license-file:        LICENSE-author:              Tyler Olson-maintainer:          tydotg@gmail.com-copyright:           2016 Tyler Olson-category:            Hardware-build-type:          Simple-cabal-version:       >=1.10+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack +name:           gpio+version:        0.1.0.3+synopsis:       Haskell GPIO interface, designed specifically for the RaspberryPi.+description:    Please see README.md+category:       Hardware+homepage:       http://github.com/tgolson/gpio+author:         Tyler Olson+maintainer:     tydotg@gmail.com+copyright:      2016 Tyler Olson+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10 +extra-source-files:+    README.md+ library-  hs-source-dirs:   src/lib-  ghc-options:      -Wall-  default-language: Haskell2010-  exposed-modules: System.GPIO, System.GPIO.Types-  default-extensions:-      OverloadedStrings NoImplicitPrelude LambdaCase-      StandaloneDeriving FlexibleContexts ScopedTypeVariables-      KindSignatures DataKinds GADTs+  hs-source-dirs:+      lib+  default-extensions: DataKinds DeriveGeneric FlexibleContexts FlexibleInstances GADTs KindSignatures LambdaCase OverloadedStrings ScopedTypeVariables StandaloneDeriving+  ghc-options: -Wall   build-depends:-      base >= 4.5 && < 5,-      basic-prelude,-      monad-control,-      string-conversions+      base >= 4.7 && < 5+    , directory+    , exceptions+    , monad-control+    , optparse-generic+    , safe+  exposed-modules:+      System.GPIO+  other-modules:+      System.GPIO.Path+      System.GPIO.Types+      Paths_gpio+  default-language: Haskell2010  executable gpio-  hs-source-dirs:   src/gpio-  ghc-options:      -Wall-  default-language: Haskell2010-  main-is:          Main.hs+  main-is: Main.hs+  hs-source-dirs:+      exec+  default-extensions: DataKinds DeriveGeneric FlexibleContexts FlexibleInstances GADTs KindSignatures LambdaCase OverloadedStrings ScopedTypeVariables StandaloneDeriving+  ghc-options: -Wall   build-depends:-      base >= 4.5 && < 5,-      gpio,-      basic-prelude,-      optparse-generic,-      string-conversions-  default-extensions:-      OverloadedStrings NoImplicitPrelude LambdaCase-      StandaloneDeriving FlexibleContexts ScopedTypeVariables-      KindSignatures DataKinds GADTs DeriveGeneric+      base >= 4.7 && < 5+    , directory+    , exceptions+    , monad-control+    , optparse-generic+    , safe+    , gpio+  default-language: Haskell2010
+ lib/System/GPIO.hs view
@@ -0,0 +1,112 @@+module System.GPIO+    -- Re-exported types+    ( Pin(..)+    , fromInt+    , ActivePin+    , Value(..)+    , Direction++    -- Exported API+    , 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)+++-- Get an active pin from a pin, preserving the invariants required when a pin is initialized.+-- Useful for CLI type commands where pointers to an active pin can be lost between calls.+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
+ lib/System/GPIO/Path.hs view
@@ -0,0 +1,31 @@+module System.GPIO.Path+    ( basePath+    , exportPath+    , unexportPath+    , pinPath+    , valuePath+    , directionPath+    ) where++import Data.Monoid       ((<>))++import System.GPIO.Types+++basePath :: FilePath+basePath = "/sys/class/gpio"++exportPath :: FilePath+exportPath = basePath <> "/export"++unexportPath :: FilePath+unexportPath = basePath <> "/unexport"++pinPath :: Pin -> FilePath+pinPath pin = basePath <> "/gpio" <> toPath pin++valuePath :: Pin -> FilePath+valuePath pin = pinPath pin <> "/value"++directionPath :: Pin -> FilePath+directionPath pin = pinPath pin <> "/direction"
+ lib/System/GPIO/Types.hs view
@@ -0,0 +1,82 @@+module System.GPIO.Types+    ( Pin(..)+    , pinNum+    , fromInt+    , unpin+    , direction+    , ActivePin(..)+    , Direction(..)+    , Value(..)+    , toPath+    , toData+    , fromData+    ) where+++import Data.Monoid ((<>))+import Safe+++-- Available pins and ordering of the pin numbers corresponds to chart found here:+-- https://www.raspberrypi.org/documentation/usage/gpio-plus-and-raspi2/+data Pin+    = P2  | P3  | P4  | P17 | P27 | P22 | P10 | P9  | P11 | P5  | P6  | P13 | P19 | P26+    | P14 | P15 | P18 | P23 | P24 | P25 | P8  | P7  | P12 | P16 | P20 | P21+  deriving (Eq, Read, Show, Enum)++instance ToPath Pin where toPath = show . pinNum+instance ToData Pin where toData = toPath++pinNum :: Pin -> Int+pinNum = read . tail . show++fromInt :: Int -> Maybe Pin+fromInt x = readMay ("P" ++ show x)++data ActivePin (a :: Direction) where+    ReaderPin :: Pin -> ActivePin 'In+    WriterPin :: Pin -> ActivePin 'Out++deriving instance Show (ActivePin a)++unpin :: ActivePin a -> Pin+unpin = \case ReaderPin p -> p+              WriterPin p -> p++direction :: ActivePin a -> Direction+direction = \case ReaderPin _ -> In+                  WriterPin _ -> Out+++data Direction = In | Out deriving (Eq, Show)++instance ToData Direction where+    toData = \case In  -> "in"+                   Out -> "out"++instance FromData Direction where+    fromData = \case "in"  -> Right In+                     "out" -> Right Out+                     x     -> Left ("Cannot parse \"Direction\" from \"" <> x <> "\"")+++data Value = HI | LO deriving (Eq, Show)++instance ToData Value where+    toData = \case HI -> "1"+                   LO -> "0"++instance FromData Value where+    fromData = \case "1" -> Right HI+                     "0" -> Right LO+                     x   -> Left ("Cannot parse \"Value\" from \"" <> x <> "\"")+++class ToPath a where+    toPath :: a -> FilePath++class ToData a where+    toData :: a -> String++class FromData a where+    fromData :: String -> Either String a
− src/gpio/Main.hs 
@@ -1,57 +0,0 @@-module Main (main) where--import BasicPrelude-import Data.String.Conversions-import Options.Generic--import System.GPIO-import System.GPIO.Types--data InputCommand-    = Export Int String-    | Unexport Int-    | Read Int-    | Write Int String-  deriving (Generic, Show)--instance ParseRecord InputCommand---- optparse-generic has trouble with nested types--- so we can't make 'Command' a parse record--- Instead we use RawCommand for the generic instance, then--- convert to the actual 'Command' type.-data Command-    = CmdExport Pin Dir-    | CmdUnexport Pin-    | CmdRead Pin-    | CmdWrite Pin Value-  deriving (Generic, Show)---toCommand :: InputCommand -> Either Text Command-toCommand =-    \case Export i "in"  -> (`CmdExport` In)  <$> parsePin i-          Export i "out" -> (`CmdExport` Out) <$> parsePin i-          Export _ _     -> Left "Usage error: use 'in' or 'out' for export direction."-          Unexport i     -> CmdUnexport       <$> parsePin i-          Read i         -> CmdRead           <$> parsePin i-          Write i "hi"   -> (`CmdWrite` HI)   <$> parsePin i-          Write i "lo"   -> (`CmdWrite` LO)   <$> parsePin i-          Write _ _      -> Left "Usage error: use 'hi' or 'lo' for write value."-  where-    parsePin i = case fromInt i of-        Nothing -> Left ("Usage error: could not parse pin value from integer: " ++ show i)-        Just p  -> Right p--main :: IO ()-main =-    toCommand <$> getRecord "GPIO" >>= \case-        Left e    -> error (convertString e)-        Right cmd -> case cmd of-            CmdExport p In  -> void (initReaderPin p)-            CmdExport p Out -> void (initWriterPin p)-            -- Note: chose a random pin type when closing the pin-            -- the type doesn't actually matter...-            CmdUnexport p   -> closePin (ReaderPin p)-            CmdRead p       -> readPin (ReaderPin p) >>= print-            CmdWrite p v    -> writePin (WriterPin p) v
− src/lib/System/GPIO.hs 
@@ -1,103 +0,0 @@-module System.GPIO-    -- Re-exported types-    ( Pin(..)-    , ActivePin-    , Value(..)-    , Dir(..)--    -- Exported API-    , initReaderPin-    , initWriterPin-    , readPin-    , writePin-    , closePin-    ) where--import BasicPrelude-import Control.Monad.Trans.Control-import Data.String.Conversions--import System.GPIO.Types----- Exported API ------------------------------------------------------------------initReaderPin :: (MonadBaseControl IO m, MonadIO m) => Pin -> m (ActivePin 'In)-initReaderPin p = initPin activePin >> return activePin-  where activePin = ReaderPin p--initWriterPin :: (MonadBaseControl IO m, MonadIO m) => Pin -> m (ActivePin 'Out)-initWriterPin p = initPin activePin >> return activePin-  where activePin = WriterPin p--readPin :: (MonadBaseControl IO m, MonadIO m) => ActivePin a -> m Value-readPin p = do-    x <- liftIO $ readFile (valuePath $ pin p)--    -- TODO: handle errors after cleaning this up...-    case fromText (runLineHack x) of-        Right v -> return v-        Left e  -> error $ convertString $-            "Error reading value file for \"" <> show p <> "\": " <> e-  where-    -- Note: too lazy to properly handle new lines in the value files-    -- it looks like the gpio interface appends newlines-    -- so file is read as "1\n"-    -- TODO: handle correctly, maybe use hGetChar or something...-    runLineHack t = case lines t of-        [] -> error "Error: runLineHack failed us."-        (x:_) -> x--writePin :: (MonadBaseControl IO m, MonadIO m) => ActivePin 'Out -> Value -> m ()-writePin p v = withVerboseError-    ("Error writing value \"" <> show v <> "\" to " <> show p <> ".")-    $ liftIO (writeFile (valuePath $ pin p) (toText v))--closePin :: (MonadBaseControl IO m, MonadIO m) => ActivePin a -> m ()-closePin p = withVerboseError-    ("Error closing " <> show p <> ". Was this pin already closed?")-    $ liftIO (writeFile unexportPath (pinNumT $ pin p))----- Internal Pin Utils ------------------------------------------------------------initPin :: (MonadBaseControl IO m, MonadIO m) => ActivePin a -> m ()-initPin p = do-    let exportErrorMsg = "Error initializing " <> show p <> ". Was this pin already initialized?"-        setDirErrorMsg = "Error setting direction for " <> show p <> "."-    withVerboseError exportErrorMsg export-    withVerboseError setDirErrorMsg setDirection-  where-    export = liftIO $ writeFile exportPath (pinNumT $ pin p)-    setDirection = liftIO $ writeFile (directionPath $ pin p) (toText dir)-    dir :: Dir-    dir = case p of ReaderPin _ -> In-                    WriterPin _ -> Out---withVerboseError :: (MonadBaseControl IO m) => Text -> m () -> m ()-withVerboseError msg = handle handleError-  where-    handleError :: SomeException -> m ()-    handleError e = error $ convertString (msg <> "\nRaw Error: " <> show e)----- Path Utils --------------------------------------------------------------------basePath :: FilePath-basePath = "/sys/class/gpio"--exportPath :: FilePath-exportPath = basePath <> "/export"--unexportPath :: FilePath-unexportPath = basePath <> "/unexport"--pinPath :: Pin -> FilePath-pinPath p = basePath <> "/gpio" <> convertString (pinNumT p)--valuePath :: Pin -> FilePath-valuePath p = pinPath p <> "/value"--directionPath :: Pin -> FilePath-directionPath p = pinPath p <> "/direction"
− src/lib/System/GPIO/Types.hs 
@@ -1,77 +0,0 @@-module System.GPIO.Types-    ( Pin(..)-    , pinNum-    , pinNumT-    , fromInt-    , ActivePin(..)-    , pin-    , Dir(..)-    , Value(..)-    , fromText-    , toText-    ) where--import BasicPrelude-import Data.String.Conversions----- Core Types --------------------------------------------------------------------data Pin = P18 | P23 | P24 | P25 deriving (Eq, Show, Enum)--pinNumDict :: [(Pin, Int)]-pinNumDict = [ (P18, 18)-             , (P23, 23)-             , (P24, 24)-             , (P25, 25)-             ]--pinNum :: Pin -> Int-pinNum p = fromMaybe unexpectedError (lookup p pinNumDict)-  where-    unexpectedError = error $ convertString-        ("Unexpected error. " ++ show p ++ " not defined in 'pinNumDict'")--pinNumT :: Pin -> Text-pinNumT = show . pinNum--fromInt :: Int -> Maybe Pin-fromInt i = lookup i (swap <$> pinNumDict)--data ActivePin (a :: Dir) where-    ReaderPin :: Pin -> ActivePin 'In-    WriterPin :: Pin -> ActivePin 'Out--deriving instance Show (ActivePin a)--pin :: ActivePin a -> Pin-pin = \case ReaderPin p -> p-            WriterPin p -> p--data Dir = In | Out deriving (Show)--instance ToText Dir where-    toText = \case In  -> "in"-                   Out -> "out"-instance FromText Dir where-    fromText = \case "in"  -> Right In-                     "out" -> Right Out-                     x     -> Left ("Cannot parse \"Dir\" from \"" <> x <> "\"")--data Value = HI | LO deriving (Show)--instance ToText Value where-    toText = \case HI -> "1"-                   LO -> "0"-instance FromText Value where-    fromText = \case "1" -> Right HI-                     "0" -> Right LO-                     x   -> Left ("Cannot parse \"Value\" from \"" <> x <> "\"")---- We are going to do a lot of reading/writing to files w/ custom data types.--- Create a small interface to keep conversions consistent.-class ToText a where-    toText :: a -> Text--class FromText a where-    fromText :: Text -> Either Text a