gpio (empty) → 0.1.0.0
raw patch · 6 files changed
+294/−0 lines, 6 filesdep +basedep +basic-preludedep +gpiosetup-changed
Dependencies added: base, basic-prelude, gpio, monad-control, string-conversions
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- gpio.cabal +43/−0
- src/gpio/Main.hs +50/−0
- src/lib/System/GPIO.hs +103/−0
- src/lib/System/GPIO/Types.hs +66/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ gpio.cabal view
@@ -0,0 +1,43 @@+name: gpio+version: 0.1.0.0+synopsis: Simple project template from stack+description: Please see README.md+homepage: http://github.com/githubuser/gpio#readme+license: BSD3+license-file: LICENSE+author: Author name here+maintainer: example@example.com+copyright: 2016 Author name here+category: Web+build-type: Simple+cabal-version: >=1.10+++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+ build-depends:+ base >= 4.5 && < 5,+ basic-prelude,+ string-conversions,+ monad-control++executable gpio+ hs-source-dirs: src/gpio+ ghc-options: -Wall+ default-language: Haskell2010+ main-is: Main.hs+ build-depends:+ base >= 4.5 && < 5,+ gpio,+ basic-prelude+ default-extensions:+ OverloadedStrings NoImplicitPrelude LambdaCase+ StandaloneDeriving FlexibleContexts ScopedTypeVariables+ KindSignatures DataKinds GADTs
+ src/gpio/Main.hs view
@@ -0,0 +1,50 @@+module Main (main) where++import BasicPrelude+import Control.Concurrent++import System.GPIO+import System.GPIO.Types++main :: IO ()+main =+ getArgs >>= \case+ ["export", i, dir] -> case (readMay i >>= fromInt, fromText dir) of+ (Just p, Right d) -> case d of+ In -> void (initReaderPin p)+ Out -> void (initWriterPin p)+ _ -> usageError+ ["unexport", i] -> case readMay i >>= fromInt of+ -- Note: chose a random pin type when closing the pin - doesn't matter...+ Just p -> closePin (ReaderPin p)+ Nothing -> usageError+ ["read", i] -> case readMay i >>= fromInt of+ Nothing -> usageError+ Just p -> readPin (ReaderPin p) >>= print+ ["write", i, val] -> case (readMay i >>= fromInt, fromText val) of+ (Just p, Right v) -> writePin (WriterPin p) v+ _ -> usageError+ [x] -> case (readMay x :: Maybe Int) of+ Nothing -> usageError+ Just i -> runTest i+ _ -> error "Illegal usage!"+ where+ usageError = error "gpio (init PIN_NUM DIR|close PIN_NUM|read PIN_NUM|write PIN_NUM VALUE|SECONDS)"+ runTest s = do+ putStrLn "In program"+ p <- initWriterPin P18++ putStrLn $ "Got pin: " ++ show p+ writePin p HI++ putStrLn "Set to HI"+ v <- readPin p+ putStrLn $ "Pin value: " <> show v++ threadDelay (1000000 * s)+ putStrLn "Delay over"++ writePin p LO+ v' <- readPin p+ putStrLn $ "New Pin value: " <> show v'+ closePin p
+ src/lib/System/GPIO.hs view
@@ -0,0 +1,103 @@+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 :: Pin -> IO (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 view
@@ -0,0 +1,66 @@+module System.GPIO.Types 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