├── .gitignore ├── Setup.hs ├── pin-diagram.png ├── examples ├── turn-off.hs ├── pwm-example.hs ├── isr-example.hs ├── write-byte-example.hs ├── output-example.hs ├── wpi-fishdish.hs ├── wiringPi-test.hs └── LICENSE-FOR-EXAMPLES ├── CHANGELOG ├── LICENSE ├── src └── System │ └── Hardware │ ├── WiringPi │ └── Enums.hs │ └── WiringPi.hs ├── src-dummy └── System │ └── Hardware │ └── WiringPi │ └── Foreign.hs ├── README.md ├── src-foreign └── System │ └── Hardware │ └── WiringPi │ └── Foreign.hsc └── wiringPi.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | *~ 3 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /pin-diagram.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mignon-p/hs-wiringPi/HEAD/pin-diagram.png -------------------------------------------------------------------------------- /examples/turn-off.hs: -------------------------------------------------------------------------------- 1 | -- Configures wiringPi pins 0-7 as outputs, and sets them to LOW. 2 | 3 | import Control.Monad 4 | 5 | import System.Hardware.WiringPi 6 | 7 | main = do 8 | forM_ [0..7] $ \x -> pinMode (Wpi x) OUTPUT 9 | digitalWriteByte 0 10 | -------------------------------------------------------------------------------- /examples/pwm-example.hs: -------------------------------------------------------------------------------- 1 | -- Example of using pwmWrite. 2 | -- Run with an LED connected to wiringPi pin 1: 3 | -- https://www.flickr.com/photos/107479024@N04/32201782695/ 4 | -- Pulses the LED. 5 | -- Compatible with the hs-wiringPi test board. 6 | -- https://github.com/ppelleti/hs-wiringPi-test-board 7 | 8 | import Control.Concurrent 9 | import Control.Monad 10 | 11 | import System.Hardware.WiringPi 12 | 13 | pwmPin = Wpi 1 14 | 15 | main = do 16 | pinMode pwmPin PWM_OUTPUT 17 | forM_ [0, 0.1 ..] $ \x -> do 18 | let y = (sin x + 1) / 2 19 | y' = y ** 2.8 -- gamma correction 20 | analog = y' * 1024 21 | pwmWrite pwmPin $ round analog 22 | threadDelay 50000 23 | -------------------------------------------------------------------------------- /CHANGELOG: -------------------------------------------------------------------------------- 1 | -*- Text -*- 2 | 3 | 1.0.1.1 @ Thu Oct 5 11:18:47 PDT 2017 4 | 5 | * Changed some of the examples to work with the hs-wiringPi test board. 6 | 7 | * No changes to the library. 8 | 9 | 1.0.1 @ Mon Mar 27 13:30:49 PDT 2017 10 | 11 | * Examples for Pi-LITEr and Fish Dish boards. 12 | 13 | * Added piGpioLayout as a synonym for piBoardRev, to reflect the name 14 | change in version 2.36 of the C library. 15 | 16 | * Addition of wiringPiISR function. (Contributed by Satoshi Ogata.) 17 | 18 | * Improvements to documentation and examples. 19 | 20 | 1.0 @ Mon Jan 23 17:51:35 PST 2017 21 | 22 | * Initialization is now automatic. 23 | 24 | * Pin now has three constructors, one for each pin numbering scheme. 25 | You can now mix pin numbering schemes in a single program, rather 26 | than having to choose one at initialization time. 27 | 28 | 0.1 @ Tue Jan 10 21:15:33 UTC 2017 29 | 30 | * Initial release. 31 | -------------------------------------------------------------------------------- /examples/isr-example.hs: -------------------------------------------------------------------------------- 1 | -- Example of using wiringPiISR. 2 | -- Run with LED connected to wiringPi pin 1 (GPIO 18) 3 | -- and button connected to wiringPi pin 25 (GPIO 26). 4 | -- Lights the LED when button is pressed. 5 | -- https://goo.gl/photos/VjPDQ8HW1Dp2vEFW7 6 | -- Compatible with the hs-wiringPi test board. 7 | -- https://github.com/ppelleti/hs-wiringPi-test-board 8 | -- You need to link this program with "-threaded", or deadlock will occur. 9 | 10 | import Control.Concurrent 11 | import Control.Monad 12 | import Data.IORef 13 | 14 | import System.Hardware.WiringPi 15 | 16 | led :: Pin 17 | led = Wpi 1 18 | 19 | button :: Pin 20 | button = Wpi 25 21 | 22 | -- Is button connected to GND? 23 | activeLow :: Bool 24 | activeLow = True 25 | 26 | main = do 27 | pinMode led OUTPUT 28 | pinMode button INPUT 29 | pullUpDnControl button $ if activeLow then PUD_UP else PUD_DOWN 30 | wiringPiISR button INT_EDGE_BOTH handleButton 31 | forever $ getChar 32 | where 33 | handleButton = do 34 | val <- digitalRead button 35 | let inv = if val == LOW then HIGH else LOW 36 | digitalWrite led $ if activeLow then inv else val 37 | -------------------------------------------------------------------------------- /examples/write-byte-example.hs: -------------------------------------------------------------------------------- 1 | -- Example of using digitalWriteByte. 2 | -- Run with LEDs connected to wiringPi pins 0-7: 3 | -- https://www.flickr.com/photos/107479024@N04/31360240974/ 4 | -- Blinks the LEDs in sequence: 5 | -- https://www.flickr.com/photos/107479024@N04/32070893472/ 6 | -- Compatible with the hs-wiringPi test board: 7 | -- https://github.com/ppelleti/hs-wiringPi-test-board 8 | -- Should also work with the Ladder Board: 9 | -- https://projects.drogon.net/the-raspberry-ladder-board/ 10 | -- Can also be used with the Pi-LITEr if you change the order: 11 | -- https://pinout.xyz/pinout/pi_lite_r 12 | -- http://store.acmeun.com/products/pi-liter-8-led-strip-for-the-raspberry-pi.html 13 | 14 | import Control.Concurrent 15 | import Control.Monad 16 | import Data.Bits 17 | 18 | import System.Hardware.WiringPi 19 | 20 | -- Uncomment this to use the Pi-LITEr. 21 | -- pins = [7, 0, 2, 1, 3, 4, 5, 6] 22 | 23 | -- This works for hs-wiringPi test board, or for Ladder Board. 24 | pins = [0..7] 25 | 26 | main = do 27 | forM_ pins $ \x -> pinMode (Wpi x) OUTPUT 28 | forever $ forM_ pins $ \x -> do 29 | digitalWriteByte $ bit x 30 | threadDelay 200000 31 | -------------------------------------------------------------------------------- /examples/output-example.hs: -------------------------------------------------------------------------------- 1 | -- Example of using digitalWrite. 2 | -- Run with LEDs connected to wiringPi pins 0-7: 3 | -- https://www.flickr.com/photos/107479024@N04/31360240974/ 4 | -- Blinks the LEDs in sequence: 5 | -- https://www.flickr.com/photos/107479024@N04/32070893472/ 6 | -- Compatible with the hs-wiringPi test board. 7 | -- https://github.com/ppelleti/hs-wiringPi-test-board 8 | -- Should also work with the Ladder Board: 9 | -- https://projects.drogon.net/the-raspberry-ladder-board/ 10 | -- Can also be used with the Pi-LITEr if you change the order: 11 | -- https://pinout.xyz/pinout/pi_lite_r 12 | -- http://store.acmeun.com/products/pi-liter-8-led-strip-for-the-raspberry-pi.html 13 | 14 | import Control.Concurrent 15 | import Control.Monad 16 | 17 | import System.Hardware.WiringPi 18 | 19 | -- Uncomment this to use the Pi-LITEr. 20 | -- pins = map Wpi [7, 0, 2, 1, 3, 4, 5, 6] 21 | 22 | -- This works for hs-wiringPi test board, or for Ladder Board. 23 | pins = map Wpi [0..7] 24 | 25 | main = do 26 | forM_ pins $ \x -> pinMode x OUTPUT 27 | forever $ forM_ pins $ \x -> do 28 | digitalWrite x HIGH 29 | threadDelay 200000 30 | digitalWrite x LOW 31 | -------------------------------------------------------------------------------- /examples/wpi-fishdish.hs: -------------------------------------------------------------------------------- 1 | -- Example for "Fish Dish" board. 2 | -- https://www.pi-supply.com/product/fish-dish-raspberry-pi-led-buzzer-board/ 3 | -- http://store.acmeun.com/products/fish-dish-raspberry-pi-led-buzzer-board.html 4 | -- http://funwithsoftware.org/images/2017-FishDish-schematic.png 5 | -- Fish Dish uses some of the SPI pins as GPIO pins, so you'll need to 6 | -- disable SPI in raspi-config if it is enabled. 7 | -- You need to link this program with "-threaded", or deadlock will occur. 8 | 9 | import Control.Concurrent 10 | import Control.Exception 11 | import Control.Monad 12 | 13 | import System.Hardware.WiringPi 14 | 15 | ledPins = map Gpio [4, 22, 9] 16 | 17 | buzzerPin = Gpio 8 18 | 19 | buttonPin = Gpio 7 20 | 21 | outputPins = ledPins ++ [buzzerPin] 22 | 23 | turnOff = forM_ outputPins $ \pin -> digitalWrite pin LOW 24 | 25 | waitButton mv goal = do 26 | val <- takeMVar mv 27 | when (val /= goal) (waitButton mv goal) 28 | 29 | loop mv = forM_ ledPins $ \led -> do 30 | digitalWrite led HIGH 31 | waitButton mv HIGH 32 | digitalWrite buzzerPin HIGH 33 | waitButton mv LOW 34 | digitalWrite buzzerPin LOW 35 | digitalWrite led LOW 36 | 37 | main = do 38 | forM_ outputPins $ \pin -> pinMode pin OUTPUT 39 | pinMode buttonPin INPUT 40 | pullUpDnControl buttonPin PUD_OFF -- Fish Dish has an external pulldown 41 | turnOff 42 | mv <- newEmptyMVar 43 | wiringPiISR buttonPin INT_EDGE_BOTH (digitalRead buttonPin >>= putMVar mv) 44 | putStrLn "(Press control-C to exit)" 45 | putStrLn "Press the button on the Fish Dish..." 46 | forever (loop mv) `finally` turnOff 47 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Patrick Pelletier 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Patrick Pelletier nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /src/System/Hardware/WiringPi/Enums.hs: -------------------------------------------------------------------------------- 1 | module System.Hardware.WiringPi.Enums 2 | ( Value(..) 3 | , Mode(..) 4 | , Pud(..) 5 | , PwmMode(..) 6 | , IntEdge(..) 7 | ) where 8 | 9 | -- | Digital logic level. 10 | data Value = LOW | HIGH deriving (Eq, Ord, Show, Read, Enum, Bounded) 11 | 12 | -- | Pin mode, used with 'pinMode'. 13 | data Mode = INPUT -- ^ digital input 14 | | OUTPUT -- ^ digital output 15 | | PWM_OUTPUT -- ^ pulse-width modulation; only supported on wiringPi pins 1, 23, 24, and 26 16 | | GPIO_CLOCK -- ^ ; 17 | -- only supported on wiringPi pins 7, 21, 22, and 29 18 | deriving (Eq, Ord, Show, Read, Enum, Bounded) 19 | 20 | -- | Use with 'pullUpDnControl' to enable internal pull-up or pull-down 21 | -- resistor. 22 | data Pud = PUD_OFF -- ^ disable pull-up/pull-down 23 | | PUD_DOWN -- ^ enable pull-down resistor 24 | | PUD_UP -- ^ enable pull-up resistor 25 | deriving (Eq, Ord, Show, Read, Enum, Bounded) 26 | 27 | -- | Argument to 'pwmSetMode' to set \"balanced\" mode or \"mark-space\" mode. 28 | data PwmMode = PWM_MODE_BAL -- ^ balanced mode 29 | | PWM_MODE_MS -- ^ mark-space mode 30 | deriving (Eq, Ord, Show, Read, Enum, Bounded) 31 | 32 | -- | Interrupt levels, used with 'wiringPiISR'. 33 | data IntEdge = INT_EDGE_SETUP -- ^ no initialization of the pin will happen 34 | | INT_EDGE_FALLING -- ^ interrupt on a falling edge of the incoming signal 35 | | INT_EDGE_RISING -- ^ interrupt on a rising edge of the incoming signal 36 | | INT_EDGE_BOTH -- ^ interrupt on both rising edge and falling 37 | -- edge of the incoming signal 38 | deriving (Eq, Ord, Show, Read, Enum, Bounded) 39 | -------------------------------------------------------------------------------- /src-dummy/System/Hardware/WiringPi/Foreign.hs: -------------------------------------------------------------------------------- 1 | module System.Hardware.WiringPi.Foreign 2 | ( valueToInt 3 | , intToValue 4 | , modeToInt 5 | , pudToInt 6 | , pwmModeToInt 7 | , intEdgeToInt 8 | , c_wiringPiSetupGpio 9 | , c_pinMode 10 | , c_pullUpDnControl 11 | , c_digitalRead 12 | , c_digitalWrite 13 | , c_pwmWrite 14 | , c_digitalWriteByte 15 | , c_pwmSetMode 16 | , c_pwmSetRange 17 | , c_pwmSetClock 18 | , c_wpiPinToGpio 19 | , c_physPinToGpio 20 | , mkWiringPiISRCallback 21 | , c_wiringPiISR 22 | ) where 23 | 24 | import Foreign.C.Types ( CInt(..), CUInt(..) ) 25 | import Foreign.Ptr ( FunPtr ) 26 | import System.Hardware.WiringPi.Enums 27 | 28 | valueToInt :: Value -> CInt 29 | valueToInt LOW = 0 30 | valueToInt HIGH = 1 31 | 32 | intToValue :: CInt -> Value 33 | intToValue 0 = LOW 34 | intToValue _ = HIGH 35 | 36 | modeToInt :: Mode -> CInt 37 | modeToInt INPUT = 2 38 | modeToInt OUTPUT = 3 39 | modeToInt PWM_OUTPUT = 4 40 | modeToInt GPIO_CLOCK = 5 41 | 42 | pudToInt :: Pud -> CInt 43 | pudToInt PUD_OFF = 6 44 | pudToInt PUD_DOWN = 7 45 | pudToInt PUD_UP = 8 46 | 47 | pwmModeToInt :: PwmMode -> CInt 48 | pwmModeToInt PWM_MODE_BAL = 9 49 | pwmModeToInt PWM_MODE_MS = 10 50 | 51 | intEdgeToInt :: IntEdge -> CInt 52 | intEdgeToInt INT_EDGE_SETUP = 11 53 | intEdgeToInt INT_EDGE_FALLING = 12 54 | intEdgeToInt INT_EDGE_RISING = 13 55 | intEdgeToInt INT_EDGE_BOTH = 14 56 | 57 | c_wiringPiSetupGpio :: IO CInt 58 | c_wiringPiSetupGpio = return 0 59 | 60 | c_pinMode :: CInt 61 | -> CInt 62 | -> IO () 63 | c_pinMode _ _ = return () 64 | 65 | c_pullUpDnControl :: CInt 66 | -> CInt 67 | -> IO () 68 | c_pullUpDnControl _ _ = return () 69 | 70 | c_digitalRead :: CInt 71 | -> IO CInt 72 | c_digitalRead _ = return 0 73 | 74 | c_digitalWrite :: CInt 75 | -> CInt 76 | -> IO () 77 | c_digitalWrite _ _ = return () 78 | 79 | c_pwmWrite :: CInt 80 | -> CInt 81 | -> IO () 82 | c_pwmWrite _ _ = return () 83 | 84 | c_digitalWriteByte :: CInt 85 | -> IO () 86 | c_digitalWriteByte _ = return () 87 | 88 | c_pwmSetMode :: CInt 89 | -> IO () 90 | c_pwmSetMode _ = return () 91 | 92 | c_pwmSetRange :: CUInt 93 | -> IO () 94 | c_pwmSetRange _ = return () 95 | 96 | c_pwmSetClock :: CInt 97 | -> IO () 98 | c_pwmSetClock _ = return () 99 | 100 | c_wpiPinToGpio :: CInt 101 | -> IO CInt 102 | c_wpiPinToGpio _ = return (-1) 103 | 104 | c_physPinToGpio :: CInt 105 | -> IO CInt 106 | c_physPinToGpio _ = return (-1) 107 | 108 | mkWiringPiISRCallback :: IO () 109 | -> IO (FunPtr (IO ())) 110 | mkWiringPiISRCallback = undefined 111 | 112 | c_wiringPiISR :: CInt 113 | -> CInt 114 | -> FunPtr (IO ()) 115 | -> IO CInt 116 | c_wiringPiISR = undefined 117 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Hackage](https://img.shields.io/hackage/v/wiringPi.svg)](https://hackage.haskell.org/package/wiringPi) 2 | 3 | This is a Haskell binding to the [wiringPi library][1], which allows 4 | you to interface with the [GPIO][4] pins on the [Raspberry Pi][2]. 5 | Unlike some other solutions for using the Raspberry Pi's GPIO pins, 6 | wiringPi provides access to more advanced features, such as enabling 7 | the internal pull-up or pull-down resistors. 8 | 9 | ## Usage 10 | 11 | To use this library, you must either run as root, or set the 12 | `WIRINGPI_GPIOMEM` environment variable. (Set it to anything; the 13 | value does not matter.) However, [PWM][7] will not work if 14 | `WIRINGPI_GPIOMEM` is set. 15 | 16 | This library will only build on the Raspberry Pi. Before building 17 | this library, you must install the "wiringPi" C library on your 18 | Raspberry Pi, like this: 19 | 20 | sudo apt-get install wiringpi 21 | 22 | Tested on a Raspberry Pi Model B, with [Raspbian Jessie Lite][3], 23 | using the system-provided Haskell compiler. (GHC 7.6.3.) 24 | 25 | ## Pin Numbering 26 | 27 | WiringPi allows each pin to be identified by one of three names. A 28 | pin can be identified by its physical pin number, by its Broadcom GPIO 29 | number (this is the one most commonly used in the Raspberry Pi 30 | community), or by its wiringPi pin number. The `Pin` type has three 31 | constructors (`Wpi`, `Gpio`, and `Phys`), allowing you to call a pin 32 | by any of its three names. These names are synonymous and 33 | interchangeable. 34 | 35 | The following diagram illustrates the three names of each pin, and 36 | also identifies which pins can be placed in `PWM_OUTPUT` mode or 37 | [`GPIO_CLOCK`][8] mode. 38 | 39 | ![Pinout](https://raw.githubusercontent.com/ppelleti/hs-wiringPi/master/pin-diagram.png) 40 | 41 | Similar diagrams are available on [the wiringPi site][5] or on 42 | [pinout.xyz][6]. 43 | 44 | One additional wrinkle is that some very early Raspberry Pis use 45 | different Broadcom GPIO numbers for a few of the pins. WiringPi 46 | automatically takes this into account, but it means that equality for 47 | `Pin` actually depends on which board revision you have. 48 | 49 | ## Licensing 50 | 51 | This Haskell binding is licensed under the 3-clause BSD license, and 52 | the examples in the `examples` directory are in the public domain. 53 | However, be aware that the wiringPi C library itself is licensed under 54 | the LGPLv3+. 55 | 56 | ## Examples 57 | 58 | There are several examples in the `examples` directory. You can run 59 | each example by wiring up a circuit on a breadboard as specified by 60 | the comments in the example. Or, for something more permanent and 61 | professional-looking, you can use the 62 | [hs-wiringPi test board](https://github.com/ppelleti/hs-wiringPi-test-board). 63 | The hs-wiringPi test board can be used with all of the examples, 64 | except for `wpi-fishdish`, which requires the 65 | [Fish Dish](https://www.pi-supply.com/product/fish-dish-raspberry-pi-led-buzzer-board/) 66 | board instead. 67 | 68 | [1]: http://wiringpi.com/ 69 | [2]: https://www.raspberrypi.org/ 70 | [3]: https://www.raspberrypi.org/downloads/raspbian/ 71 | [4]: https://en.wikipedia.org/wiki/General-purpose_input/output 72 | [5]: http://wiringpi.com/pins/ 73 | [6]: https://pinout.xyz/pinout/wiringpi 74 | [7]: https://en.wikipedia.org/wiki/Pulse-width_modulation 75 | [8]: https://pinout.xyz/pinout/gpclk 76 | -------------------------------------------------------------------------------- /examples/wiringPi-test.hs: -------------------------------------------------------------------------------- 1 | -- This is a basic test of most of wiringPi's functionality. 2 | -- You should connect LEDs to wiringPi pins 0-7, 23, and 26 via 3 | -- appropriate resistors. Connect wiringPi pins 21 and 22 to each other 4 | -- via a 1K resistor. Connect wiringPi pin 25 to a momentary 5 | -- pushbutton that can pull it to GND via a 1K resistor. 6 | -- This is compatible with the hs-wiringPi Test Board: 7 | -- https://github.com/ppelleti/hs-wiringPi-test-board 8 | 9 | import Control.Concurrent 10 | import Control.Monad 11 | import Data.Bits 12 | import System.Exit 13 | 14 | import System.Hardware.WiringPi 15 | 16 | ledPins = map Wpi [0..7] 17 | pwmPins = map Wpi [26, 23] 18 | connectedPins = (Wpi 21, Wpi 22) 19 | buttonPin = Wpi 25 20 | cylon = [0..6] ++ [7,6..1] 21 | 22 | shortDelay :: IO () 23 | shortDelay = threadDelay 50000 24 | 25 | assertPin :: Pin -> Value -> IO () 26 | assertPin pin expected = do 27 | actual <- digitalRead pin 28 | when (actual /= expected) $ do 29 | putStrLn $ "expected " ++ show expected ++ " on pin " ++ show pin ++ " but got " ++ show actual 30 | exitFailure 31 | 32 | -- Given two pins connected together, test that setting the value 33 | -- of one as an output changes the value of the other as an input. 34 | testConnected :: Pin -> Pin -> IO () 35 | testConnected x y = do 36 | -- setup 37 | pinMode x INPUT 38 | pullUpDnControl x PUD_OFF 39 | pinMode y OUTPUT 40 | 41 | -- test with both HIGH and LOW 42 | forM_ [HIGH, LOW] $ \val -> do 43 | digitalWrite y val 44 | shortDelay 45 | assertPin x val 46 | 47 | -- leave both pins as inputs 48 | pinMode y INPUT 49 | 50 | -- test pullup/pulldown functionality (assumes button is not pressed) 51 | testPullUpDown :: IO () 52 | testPullUpDown = do 53 | -- setup 54 | pinMode buttonPin INPUT 55 | 56 | -- test both pulldown and pullup 57 | forM_ [(PUD_DOWN, LOW), (PUD_UP, HIGH)] $ \(pud, val) -> do 58 | pullUpDnControl buttonPin pud 59 | shortDelay 60 | assertPin buttonPin val 61 | 62 | -- blink LEDs and wait for user to press button 63 | blinkAndWait :: IO () 64 | blinkAndWait = do 65 | -- setup 66 | putStrLn "Two LEDs should be pulsing, and eight LEDs should be blinking." 67 | putStrLn "Press button to exit." 68 | forM_ ledPins $ \pin -> pinMode pin OUTPUT 69 | forM_ pwmPins $ \pin -> pinMode pin PWM_OUTPUT 70 | pinMode buttonPin INPUT 71 | pullUpDnControl buttonPin PUD_UP 72 | 73 | -- blink LEDs and wait for button to be pressed 74 | let loop x = do 75 | let k = 2 * pi / fromIntegral (length cylon) 76 | y1 = (cos (x * k) + 1) / 2 77 | y2 = 1 - y1 78 | y' = map (** 2.8) [y1, y2] -- gamma correction 79 | analog = map (* 1024) y' 80 | zipWithM_ (\pin a -> pwmWrite pin $ round a) pwmPins analog 81 | let n = cylon !! (floor x `mod` length cylon) 82 | digitalWriteByte $ bit n 83 | shortDelay 84 | button <- digitalRead buttonPin 85 | when (button == HIGH) $ loop (x + 0.1) 86 | 87 | loop 0 88 | 89 | -- leave all LEDs off 90 | forM_ ledPins $ \pin -> digitalWrite pin LOW 91 | forM_ pwmPins $ \pin -> pwmWrite pin 0 92 | 93 | main = do 94 | rev <- piGpioLayout 95 | putStrLn $ "piGpioLayout = " ++ show rev 96 | 97 | testConnected (fst connectedPins) (snd connectedPins) 98 | testConnected (snd connectedPins) (fst connectedPins) 99 | testPullUpDown 100 | blinkAndWait 101 | -------------------------------------------------------------------------------- /src-foreign/System/Hardware/WiringPi/Foreign.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, ForeignFunctionInterface #-} 2 | 3 | module System.Hardware.WiringPi.Foreign 4 | ( valueToInt 5 | , intToValue 6 | , modeToInt 7 | , pudToInt 8 | , pwmModeToInt 9 | , intEdgeToInt 10 | , c_wiringPiSetupGpio 11 | , c_pinMode 12 | , c_pullUpDnControl 13 | , c_digitalRead 14 | , c_digitalWrite 15 | , c_pwmWrite 16 | , c_digitalWriteByte 17 | , c_pwmSetMode 18 | , c_pwmSetRange 19 | , c_pwmSetClock 20 | , c_wpiPinToGpio 21 | , c_physPinToGpio 22 | , mkWiringPiISRCallback 23 | , c_wiringPiISR 24 | ) where 25 | 26 | import Foreign.C.Types ( CInt(..), CUInt(..) ) 27 | import Foreign.Ptr ( FunPtr ) 28 | import System.Hardware.WiringPi.Enums 29 | 30 | #include 31 | 32 | valueToInt :: Value -> CInt 33 | valueToInt LOW = #const LOW 34 | valueToInt HIGH = #const HIGH 35 | 36 | intToValue :: CInt -> Value 37 | intToValue #const LOW 38 | = LOW 39 | intToValue _ = HIGH 40 | 41 | modeToInt :: Mode -> CInt 42 | modeToInt INPUT = #const INPUT 43 | modeToInt OUTPUT = #const OUTPUT 44 | modeToInt PWM_OUTPUT = #const PWM_OUTPUT 45 | modeToInt GPIO_CLOCK = #const GPIO_CLOCK 46 | 47 | pudToInt :: Pud -> CInt 48 | pudToInt PUD_OFF = #const PUD_OFF 49 | pudToInt PUD_DOWN = #const PUD_DOWN 50 | pudToInt PUD_UP = #const PUD_UP 51 | 52 | pwmModeToInt :: PwmMode -> CInt 53 | pwmModeToInt PWM_MODE_BAL = #const PWM_MODE_BAL 54 | pwmModeToInt PWM_MODE_MS = #const PWM_MODE_MS 55 | 56 | intEdgeToInt :: IntEdge -> CInt 57 | intEdgeToInt INT_EDGE_SETUP = #const INT_EDGE_SETUP 58 | intEdgeToInt INT_EDGE_FALLING = #const INT_EDGE_FALLING 59 | intEdgeToInt INT_EDGE_RISING = #const INT_EDGE_RISING 60 | intEdgeToInt INT_EDGE_BOTH = #const INT_EDGE_BOTH 61 | 62 | foreign import ccall unsafe "wiringPi.h wiringPiSetupGpio" 63 | c_wiringPiSetupGpio :: IO CInt 64 | 65 | foreign import ccall unsafe "wiringPi.h pinMode" 66 | c_pinMode :: CInt 67 | -> CInt 68 | -> IO () 69 | 70 | foreign import ccall unsafe "wiringPi.h pullUpDnControl" 71 | c_pullUpDnControl :: CInt 72 | -> CInt 73 | -> IO () 74 | 75 | foreign import ccall unsafe "wiringPi.h digitalRead" 76 | c_digitalRead :: CInt 77 | -> IO CInt 78 | 79 | foreign import ccall unsafe "wiringPi.h digitalWrite" 80 | c_digitalWrite :: CInt 81 | -> CInt 82 | -> IO () 83 | 84 | foreign import ccall unsafe "wiringPi.h pwmWrite" 85 | c_pwmWrite :: CInt 86 | -> CInt 87 | -> IO () 88 | 89 | foreign import ccall unsafe "wiringPi.h digitalWriteByte" 90 | c_digitalWriteByte :: CInt 91 | -> IO () 92 | 93 | foreign import ccall unsafe "wiringPi.h pwmSetMode" 94 | c_pwmSetMode :: CInt 95 | -> IO () 96 | 97 | foreign import ccall unsafe "wiringPi.h pwmSetRange" 98 | c_pwmSetRange :: CUInt 99 | -> IO () 100 | 101 | foreign import ccall unsafe "wiringPi.h pwmSetClock" 102 | c_pwmSetClock :: CInt 103 | -> IO () 104 | 105 | foreign import ccall unsafe "wiringPi.h wpiPinToGpio" 106 | c_wpiPinToGpio :: CInt 107 | -> IO CInt 108 | 109 | foreign import ccall unsafe "wiringPi.h physPinToGpio" 110 | c_physPinToGpio :: CInt 111 | -> IO CInt 112 | 113 | foreign import ccall "wrapper" 114 | mkWiringPiISRCallback :: IO () 115 | -> IO (FunPtr (IO ())) 116 | 117 | foreign import ccall "wiringPi.h wiringPiISR" 118 | c_wiringPiISR :: CInt 119 | -> CInt 120 | -> FunPtr (IO ()) 121 | -> IO CInt 122 | -------------------------------------------------------------------------------- /wiringPi.cabal: -------------------------------------------------------------------------------- 1 | -- Initial wiringPi.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | -- The name of the package. 5 | name: wiringPi 6 | 7 | -- The package version. See the Haskell package versioning policy (PVP) 8 | -- for standards guiding when and how versions should be incremented. 9 | -- http://www.haskell.org/haskellwiki/Package_versioning_policy 10 | -- PVP summary: +-+------- breaking API changes 11 | -- | | +----- non-breaking API additions 12 | -- | | | +--- code changes with no API change 13 | version: 1.0.1.1 14 | 15 | -- A short (one-line) description of the package. 16 | synopsis: Access GPIO pins on Raspberry Pi via wiringPi library 17 | 18 | -- A longer description of the package. 19 | description: 20 | This is a Haskell binding to the , 21 | which allows you to interface with the GPIO pins on the 22 | . 23 | Unlike some other solutions for using the Raspberry Pi's GPIO pins, 24 | wiringPi provides access to more advanced features, such as 25 | enabling the internal pull-up or pull-down resistors. 26 | 27 | -- The license under which the package is released. 28 | license: BSD3 29 | 30 | -- The file containing the license text. 31 | license-file: LICENSE 32 | 33 | -- The package author(s). 34 | author: Patrick Pelletier 35 | 36 | -- An email address to which users can send suggestions, bug reports, and 37 | -- patches. 38 | maintainer: code@funwithsoftware.org 39 | 40 | -- A copyright notice. 41 | copyright: © Patrick Pelletier, 2017 42 | 43 | homepage: https://github.com/ppelleti/hs-wiringPi 44 | 45 | bug-reports: https://github.com/ppelleti/hs-wiringPi/issues 46 | 47 | category: Hardware, Raspberrypi 48 | 49 | build-type: Simple 50 | 51 | -- Extra files to be distributed with the package, such as examples or a 52 | -- README. 53 | extra-source-files: README.md 54 | , CHANGELOG 55 | , pin-diagram.png 56 | , examples/LICENSE-FOR-EXAMPLES 57 | 58 | -- Constraint on the version of Cabal needed to build this package. 59 | cabal-version: >=1.10 60 | 61 | tested-with: GHC == 7.6.3 62 | 63 | source-repository head 64 | Type: git 65 | Location: https://github.com/ppelleti/hs-wiringPi.git 66 | 67 | 68 | library 69 | -- Modules exported by the library. 70 | exposed-modules: System.Hardware.WiringPi 71 | 72 | -- Modules included in this library but not exported. 73 | other-modules: System.Hardware.WiringPi.Enums 74 | , System.Hardware.WiringPi.Foreign 75 | 76 | -- LANGUAGE extensions used by modules in this package. 77 | other-extensions: CPP, ForeignFunctionInterface 78 | 79 | -- Other library packages from which modules are imported. 80 | build-depends: base >= 4.6 && < 5 81 | 82 | -- Directories containing source files. 83 | hs-source-dirs: src 84 | if arch(x86_64) 85 | hs-source-dirs: src-dummy 86 | else 87 | hs-source-dirs: src-foreign 88 | 89 | -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. 90 | build-tools: hsc2hs 91 | 92 | -- Base language which the package is written in. 93 | default-language: Haskell2010 94 | 95 | if (! arch(x86_64)) 96 | extra-libraries: wiringPi 97 | 98 | -- GHC 7.10 and up will complain about Control.Applicative being 99 | -- an unused import. So only enable warnings for lower versions of GHC. 100 | -- (The system-supplied GHC for Raspbian Jessie is GHC 7.6.3, so that 101 | -- is primarily what I'm targeting.) 102 | if impl(ghc < 7.10) 103 | ghc-options: -fwarn-unused-imports -fwarn-unused-binds 104 | 105 | executable pwm-example 106 | main-is: pwm-example.hs 107 | build-depends: base >= 4.6 && < 5 108 | , wiringPi 109 | hs-source-dirs: examples 110 | default-language: Haskell2010 111 | 112 | executable isr-example 113 | main-is: isr-example.hs 114 | build-depends: base >= 4.6 && < 5 115 | , wiringPi 116 | hs-source-dirs: examples 117 | default-language: Haskell2010 118 | -- needed when using wiringPiISR 119 | ghc-options: -threaded 120 | 121 | executable output-example 122 | main-is: output-example.hs 123 | build-depends: base >= 4.6 && < 5 124 | , wiringPi 125 | hs-source-dirs: examples 126 | default-language: Haskell2010 127 | 128 | executable write-byte-example 129 | main-is: write-byte-example.hs 130 | build-depends: base >= 4.6 && < 5 131 | , wiringPi 132 | hs-source-dirs: examples 133 | default-language: Haskell2010 134 | 135 | executable turn-off 136 | main-is: turn-off.hs 137 | build-depends: base >= 4.6 && < 5 138 | , wiringPi 139 | hs-source-dirs: examples 140 | default-language: Haskell2010 141 | 142 | executable wiringPi-test 143 | main-is: wiringPi-test.hs 144 | build-depends: base >= 4.6 && < 5 145 | , wiringPi 146 | hs-source-dirs: examples 147 | default-language: Haskell2010 148 | 149 | executable wpi-fishdish 150 | main-is: wpi-fishdish.hs 151 | build-depends: base >= 4.6 && < 5 152 | , wiringPi 153 | hs-source-dirs: examples 154 | default-language: Haskell2010 155 | -- needed when using wiringPiISR 156 | ghc-options: -threaded 157 | -------------------------------------------------------------------------------- /examples/LICENSE-FOR-EXAMPLES: -------------------------------------------------------------------------------- 1 | Creative Commons Legal Code 2 | 3 | CC0 1.0 Universal 4 | 5 | CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE 6 | LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN 7 | ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS 8 | INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES 9 | REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS 10 | PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM 11 | THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED 12 | HEREUNDER. 13 | 14 | Statement of Purpose 15 | 16 | The laws of most jurisdictions throughout the world automatically confer 17 | exclusive Copyright and Related Rights (defined below) upon the creator 18 | and subsequent owner(s) (each and all, an "owner") of an original work of 19 | authorship and/or a database (each, a "Work"). 20 | 21 | Certain owners wish to permanently relinquish those rights to a Work for 22 | the purpose of contributing to a commons of creative, cultural and 23 | scientific works ("Commons") that the public can reliably and without fear 24 | of later claims of infringement build upon, modify, incorporate in other 25 | works, reuse and redistribute as freely as possible in any form whatsoever 26 | and for any purposes, including without limitation commercial purposes. 27 | These owners may contribute to the Commons to promote the ideal of a free 28 | culture and the further production of creative, cultural and scientific 29 | works, or to gain reputation or greater distribution for their Work in 30 | part through the use and efforts of others. 31 | 32 | For these and/or other purposes and motivations, and without any 33 | expectation of additional consideration or compensation, the person 34 | associating CC0 with a Work (the "Affirmer"), to the extent that he or she 35 | is an owner of Copyright and Related Rights in the Work, voluntarily 36 | elects to apply CC0 to the Work and publicly distribute the Work under its 37 | terms, with knowledge of his or her Copyright and Related Rights in the 38 | Work and the meaning and intended legal effect of CC0 on those rights. 39 | 40 | 1. Copyright and Related Rights. A Work made available under CC0 may be 41 | protected by copyright and related or neighboring rights ("Copyright and 42 | Related Rights"). Copyright and Related Rights include, but are not 43 | limited to, the following: 44 | 45 | i. the right to reproduce, adapt, distribute, perform, display, 46 | communicate, and translate a Work; 47 | ii. moral rights retained by the original author(s) and/or performer(s); 48 | iii. publicity and privacy rights pertaining to a person's image or 49 | likeness depicted in a Work; 50 | iv. rights protecting against unfair competition in regards to a Work, 51 | subject to the limitations in paragraph 4(a), below; 52 | v. rights protecting the extraction, dissemination, use and reuse of data 53 | in a Work; 54 | vi. database rights (such as those arising under Directive 96/9/EC of the 55 | European Parliament and of the Council of 11 March 1996 on the legal 56 | protection of databases, and under any national implementation 57 | thereof, including any amended or successor version of such 58 | directive); and 59 | vii. other similar, equivalent or corresponding rights throughout the 60 | world based on applicable law or treaty, and any national 61 | implementations thereof. 62 | 63 | 2. Waiver. To the greatest extent permitted by, but not in contravention 64 | of, applicable law, Affirmer hereby overtly, fully, permanently, 65 | irrevocably and unconditionally waives, abandons, and surrenders all of 66 | Affirmer's Copyright and Related Rights and associated claims and causes 67 | of action, whether now known or unknown (including existing as well as 68 | future claims and causes of action), in the Work (i) in all territories 69 | worldwide, (ii) for the maximum duration provided by applicable law or 70 | treaty (including future time extensions), (iii) in any current or future 71 | medium and for any number of copies, and (iv) for any purpose whatsoever, 72 | including without limitation commercial, advertising or promotional 73 | purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each 74 | member of the public at large and to the detriment of Affirmer's heirs and 75 | successors, fully intending that such Waiver shall not be subject to 76 | revocation, rescission, cancellation, termination, or any other legal or 77 | equitable action to disrupt the quiet enjoyment of the Work by the public 78 | as contemplated by Affirmer's express Statement of Purpose. 79 | 80 | 3. Public License Fallback. Should any part of the Waiver for any reason 81 | be judged legally invalid or ineffective under applicable law, then the 82 | Waiver shall be preserved to the maximum extent permitted taking into 83 | account Affirmer's express Statement of Purpose. In addition, to the 84 | extent the Waiver is so judged Affirmer hereby grants to each affected 85 | person a royalty-free, non transferable, non sublicensable, non exclusive, 86 | irrevocable and unconditional license to exercise Affirmer's Copyright and 87 | Related Rights in the Work (i) in all territories worldwide, (ii) for the 88 | maximum duration provided by applicable law or treaty (including future 89 | time extensions), (iii) in any current or future medium and for any number 90 | of copies, and (iv) for any purpose whatsoever, including without 91 | limitation commercial, advertising or promotional purposes (the 92 | "License"). The License shall be deemed effective as of the date CC0 was 93 | applied by Affirmer to the Work. Should any part of the License for any 94 | reason be judged legally invalid or ineffective under applicable law, such 95 | partial invalidity or ineffectiveness shall not invalidate the remainder 96 | of the License, and in such case Affirmer hereby affirms that he or she 97 | will not (i) exercise any of his or her remaining Copyright and Related 98 | Rights in the Work or (ii) assert any associated claims and causes of 99 | action with respect to the Work, in either case contrary to Affirmer's 100 | express Statement of Purpose. 101 | 102 | 4. Limitations and Disclaimers. 103 | 104 | a. No trademark or patent rights held by Affirmer are waived, abandoned, 105 | surrendered, licensed or otherwise affected by this document. 106 | b. Affirmer offers the Work as-is and makes no representations or 107 | warranties of any kind concerning the Work, express, implied, 108 | statutory or otherwise, including without limitation warranties of 109 | title, merchantability, fitness for a particular purpose, non 110 | infringement, or the absence of latent or other defects, accuracy, or 111 | the present or absence of errors, whether or not discoverable, all to 112 | the greatest extent permissible under applicable law. 113 | c. Affirmer disclaims responsibility for clearing rights of other persons 114 | that may apply to the Work or any use thereof, including without 115 | limitation any person's Copyright and Related Rights in the Work. 116 | Further, Affirmer disclaims responsibility for obtaining any necessary 117 | consents, permissions or other rights required for any use of the 118 | Work. 119 | d. Affirmer understands and acknowledges that Creative Commons is not a 120 | party to this document and has no duty or obligation with respect to 121 | this CC0 or use of the Work. 122 | -------------------------------------------------------------------------------- /src/System/Hardware/WiringPi.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : System.Hardware.WiringPi 3 | Description : Bindings to wiringPi library 4 | Copyright : © Patrick Pelletier, 2017 5 | License : BSD3 6 | Maintainer : code@funwithsoftware.org 7 | Stability : experimental 8 | Portability : Raspberry Pi 9 | 10 | This is a Haskell binding to the . 11 | The functions here (mostly) correspond directly to the functions in the C 12 | library, except for how initialization and pin numbering are handled. 13 | To use this library, you must either run as root, or set the @WIRINGPI_GPIOMEM@ 14 | environment variable. However, if you set @WIRINGPI_GPIOMEM@, then 15 | , 16 | so to use PWM you must be root. 17 | -} 18 | 19 | module System.Hardware.WiringPi 20 | ( -- * Types 21 | Pin (..) 22 | , Value (..) 23 | , Mode (..) 24 | , Pud (..) 25 | , PwmMode (..) 26 | , IntEdge (..) 27 | , PwmValue 28 | -- * Setup function 29 | -- | See . 30 | -- Unlike the C version of wiringPi, the Haskell binding will automatically 31 | -- call the setup function the first time a wiringPi function is called. 32 | -- The only reason to call it manually is if you want to check for errors 33 | -- earlier than your first call. It is also harmless to call it multiple 34 | -- times. In the Haskell binding the \"GPIO\" 35 | -- numbering scheme is always used internally, but the 'Pin' constructors 36 | -- allow you to choose whichever numbering scheme you want, on a pin-by-pin 37 | -- basis. This avoids having to choose a single pin numbering scheme at 38 | -- initialization time, as you do with the C library. 39 | , wiringPiSetupGpio 40 | -- * Core functions 41 | -- | See . 42 | , pinMode 43 | , pullUpDnControl 44 | , digitalRead 45 | , digitalWrite 46 | , pwmWrite 47 | -- * Additional functions 48 | -- | See . 49 | , digitalWriteByte 50 | , pwmSetMode 51 | , pwmSetRange 52 | , pwmSetClock 53 | , piGpioLayout 54 | , piBoardRev 55 | , pinToBcmGpio 56 | -- * Interrupt functions 57 | -- | See . 58 | , wiringPiISR 59 | ) where 60 | 61 | import Control.Applicative 62 | import Control.Exception ( evaluate ) 63 | import Control.Monad ( when ) 64 | import Data.Ord ( comparing ) 65 | import Data.Word ( Word8, Word16 ) 66 | import Foreign.C.Types ( CInt(..) ) 67 | import System.IO.Unsafe ( unsafePerformIO ) 68 | 69 | import System.Hardware.WiringPi.Enums 70 | import System.Hardware.WiringPi.Foreign 71 | 72 | -- | Represents a . 73 | -- The constructor determines which one of the three 74 | -- pin numbering schemes is used. See 75 | -- 76 | -- for details, and a pretty picture. '==' returns true for the same physical 77 | -- pin, even if different pin numbering schemes are used. 78 | data Pin = Wpi Int -- ^ use 79 | | Gpio Int -- ^ use BCM_GPIO numbering (these are the numbers on the 80 | -- 81 | -- and on ). 82 | | Phys Int -- ^ use physical pin numbers on P1 connector 83 | deriving (Show, Read) 84 | 85 | instance Ord Pin where 86 | compare = comparing pinToBcmGpio 87 | 88 | instance Eq Pin where 89 | p1 == p2 = compare p1 p2 == EQ 90 | 91 | -- | Value used with 'pwmWrite'. Typically ranges from 0-1024, but the 92 | -- range can be increased up to 4096 by calling 'pwmSetRange'. 93 | type PwmValue = Word16 94 | 95 | doWiringPiSetup :: IO () 96 | doWiringPiSetup = do 97 | ret <- c_wiringPiSetupGpio 98 | when (ret /= 0) $ 99 | fail $ "failing return code " ++ show ret ++ " for wiringPiSetupGpio" 100 | 101 | -- Use a CAF to do initialization once. Borrowed this trick from the 102 | -- "network" package. 103 | initWiringPiSetup :: () 104 | initWiringPiSetup = unsafePerformIO $ doWiringPiSetup 105 | 106 | -- | Initialize the wiringPi library. This is optional, because it will 107 | -- automatically be called on the first use of a wiringPi function. 108 | -- Raises an exception if the underlying C function returns an error 109 | -- code. However, in practice, the C function @wiringPiSetupGpio@ 110 | -- terminates the program on error. Setting the environment variable 111 | -- @WIRINGPI_CODES@ is supposed to change this behavior, but in my 112 | -- experience it doesn't, and the program is still terminated on error. 113 | wiringPiSetupGpio :: IO () 114 | wiringPiSetupGpio = evaluate initWiringPiSetup 115 | 116 | pinMode :: Pin -> Mode -> IO () 117 | pinMode pin mode = do 118 | wiringPiSetupGpio 119 | c_pinMode (pin2bcm pin "pinMode") (modeToInt mode) 120 | 121 | pullUpDnControl :: Pin -> Pud -> IO () 122 | pullUpDnControl pin pud = do 123 | wiringPiSetupGpio 124 | c_pullUpDnControl (pin2bcm pin "pullUpDnControl") (pudToInt pud) 125 | 126 | digitalRead :: Pin -> IO Value 127 | digitalRead pin = do 128 | wiringPiSetupGpio 129 | intToValue <$> c_digitalRead (pin2bcm pin "digitalRead") 130 | 131 | digitalWrite :: Pin -> Value -> IO () 132 | digitalWrite pin val = do 133 | wiringPiSetupGpio 134 | c_digitalWrite (pin2bcm pin "digitalWrite") (valueToInt val) 135 | 136 | -- | Default range is 0-1024, but it can be changed with 'pwmSetRange'. 137 | pwmWrite :: Pin -> PwmValue -> IO () 138 | pwmWrite pin val = do 139 | wiringPiSetupGpio 140 | c_pwmWrite (pin2bcm pin "pwmWrite") (fromIntegral val) 141 | 142 | -- | Write 8 bits to the 8 pins that have wiringPi pin numbers 0-7. 143 | digitalWriteByte :: Word8 -> IO () 144 | digitalWriteByte w = do 145 | wiringPiSetupGpio 146 | c_digitalWriteByte $ fromIntegral w 147 | 148 | pwmSetMode :: PwmMode -> IO () 149 | pwmSetMode mode = do 150 | wiringPiSetupGpio 151 | c_pwmSetMode $ pwmModeToInt mode 152 | 153 | -- | Change the range used by 'pwmWrite'. Default is 1024. 154 | -- . 155 | pwmSetRange :: PwmValue -> IO () 156 | pwmSetRange range = do 157 | wiringPiSetupGpio 158 | c_pwmSetRange $ fromIntegral range 159 | 160 | -- | Change the PWM divisor. Range is 161 | -- . 162 | pwmSetClock :: PwmValue -> IO () 163 | pwmSetClock divisor = do 164 | wiringPiSetupGpio 165 | c_pwmSetClock $ fromIntegral divisor 166 | 167 | -- | Returns 1 for very early Rasbperry Pis and 2 for all others. 168 | -- This distinction is because at some point early on, the Raspberry 169 | -- Pi foundation replaced BCM_GPIO 0, 1, and 21 with BCM_GPIO 170 | -- 2, 3, and 27 at the same places on the P1 connector. Also, the 171 | -- user-accessible I²C bus changed from bus 0 to bus 1. 172 | piGpioLayout :: IO Int 173 | piGpioLayout = do 174 | -- WiringPi unceremoniously changed the name of the C function from 175 | -- piBoardRev to piGpioLayout in version 2.36. While this is a better 176 | -- name, it makes it a little harder to support both version 2.36 and 177 | -- earlier versions. I'm sure I could do something with a configure 178 | -- script to detect which function is present at build time, but instead 179 | -- I'm going to take an easier, albeit more indirect, approach. 180 | -- 181 | -- Since the point of piGpioLayout is to determine how wiringPi pin 182 | -- numbers map to BCM_GPIO numbers, I'm going to work backwards and 183 | -- observe how wiringPi pin 2 gets mapped to a GPIO number, and 184 | -- infer piGpioLayout from that. 185 | bcm <- wpiPinToGpio 2 186 | case bcm of 187 | 21 -> return 1 188 | 27 -> return 2 189 | _ -> fail $ "unexpected BCM_GPIO " ++ show bcm ++ " in piGpioLayout" 190 | 191 | -- | An alias for 'piGpioLayout'. (The wiringPi C library changed 192 | -- the name from @piBoardRev@ to @piGpioLayout@ in version 2.36, and 193 | -- really @piGpioLayout@ is a much better name for it.) 194 | piBoardRev :: IO Int 195 | piBoardRev = piGpioLayout 196 | 197 | wpiPinToGpio :: CInt -> IO CInt 198 | wpiPinToGpio x = do 199 | wiringPiSetupGpio 200 | c_wpiPinToGpio x 201 | 202 | physPinToGpio :: CInt -> IO CInt 203 | physPinToGpio x = do 204 | wiringPiSetupGpio 205 | c_physPinToGpio x 206 | 207 | -- | Sets up an interrupt handler for the specified pin. When the 208 | -- pin transitions as specified by 'IntEdge', the IO action will be 209 | -- executed. Be aware that if interrupts come quickly enough, the 210 | -- IO action might only be called once when the pin has transitioned 211 | -- more than once. If your program uses this function, you must link 212 | -- with @-threaded@, or deadlock may occur. You should only call 213 | -- @wiringPiISR@ once per pin, because the underlying C library does 214 | -- not support changing or removing an interrupt handler once it has 215 | -- been added. 216 | wiringPiISR :: Pin -> IntEdge -> IO () -> IO () 217 | wiringPiISR pin mode callback = do 218 | cb <- mkWiringPiISRCallback callback 219 | ret <- c_wiringPiISR (pin2bcm pin "wiringPiISR") (intEdgeToInt mode) cb 220 | when (ret /= 0) $ 221 | fail $ "failing return code " ++ show ret ++ " for wiringPiISR" 222 | 223 | -- | Converts a pin to its \"Broadcom GPIO\" number. (In other words, 224 | -- the pin number that would be specified with the 'Gpio' 225 | -- constructor.) This relies on 'unsafePerformIO' internally, because 226 | -- the pin mapping depends on the board revision. Returns 'Nothing' 227 | -- if the pin number is invalid; e. g. it is out of range or is a 228 | -- power or ground pin on the physical connector. See 229 | -- 230 | -- for details. (The picture depicts the mapping when 'piGpioLayout' is 2; 231 | -- there is a slightly different mapping when 'piGpioLayout' is 1.) 232 | pinToBcmGpio :: Pin -> Maybe Int 233 | pinToBcmGpio (Wpi n) = cvtPin n (unsafePerformIO . wpiPinToGpio) 234 | pinToBcmGpio (Gpio n) = cvtPin n id 235 | pinToBcmGpio (Phys n) = cvtPin n (unsafePerformIO . physPinToGpio) 236 | 237 | pin2bcm :: Pin -> String -> CInt 238 | pin2bcm p name = 239 | case pinToBcmGpio p of 240 | (Just x) -> fromIntegral x 241 | Nothing -> error $ "Illegal pin " ++ (show p) ++ " passed to " ++ name 242 | 243 | cvtPin :: Int -> (CInt -> CInt) -> Maybe Int 244 | cvtPin n f 245 | | n >= 0 && n < 64 = chkRange $ fromIntegral $ f $ fromIntegral n 246 | | otherwise = Nothing 247 | 248 | chkRange :: Int -> Maybe Int 249 | chkRange n 250 | | n >= 0 && n < 64 = Just n 251 | | otherwise = Nothing 252 | --------------------------------------------------------------------------------