hArduino 1.1 → 1.2
raw patch · 11 files changed
+86/−54 lines, 11 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGES.md +4/−1
- System/Hardware/Arduino/Comm.hs +28/−22
- System/Hardware/Arduino/Data.hs +22/−15
- System/Hardware/Arduino/Firmata.hs +4/−3
- System/Hardware/Arduino/Parts/LCD.hs +12/−4
- System/Hardware/Arduino/Parts/Piezo.hs +0/−1
- System/Hardware/Arduino/Protocol.hs +2/−0
- System/Hardware/Arduino/SamplePrograms/Counter.hs +5/−3
- System/Hardware/Arduino/SamplePrograms/LCD.hs +2/−0
- System/Hardware/Arduino/SamplePrograms/SevenSegment.hs +1/−1
- hArduino.cabal +6/−4
CHANGES.md view
@@ -1,7 +1,10 @@ * Hackage: (http://hackage.haskell.org/package/hArduino) * GitHub: (http://leventerkok.github.com/hArduino) -* Latest Hackage released version: 1.1+* Latest Hackage released version: 1.2++### Version 1.2, 2022-12-14+ * Make hArduino compile with recent versions of GHC ### Version 1.1, 2016-03-27 * Unfortunately the Firmata project moved on, and hArduino no longer
System/Hardware/Arduino/Comm.hs view
@@ -9,8 +9,11 @@ -- Basic serial communication routines ------------------------------------------------------------------------------- -{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+ module System.Hardware.Arduino.Comm where import Control.Monad (when, forever)@@ -36,8 +39,8 @@ -- | Run the Haskell program to control the board: -- -- * The file path argument should point to the device file that is--- associated with the board. ('COM1' on Windows,--- '/dev/cu.usbmodemFD131' on Mac, etc.)+-- associated with the board. (@COM1@ on Windows,+-- @/dev/cu.usbmodemFD131@ on Mac, etc.) -- -- * The boolean argument controls verbosity. It should remain -- 'False' unless you have communication issues. The print-out@@ -52,12 +55,12 @@ withArduino verbose fp program = do debugger <- mkDebugPrinter verbose debugger $ "Accessing arduino located at: " ++ show fp- listenerTid <- newEmptyMVar- let Arduino controller = do initOK <- initialize listenerTid+ lTid <- newEmptyMVar+ let Arduino controller = do initOK <- initialize lTid if initOK then program else error "Communication time-out (5s) expired."- handle (\(e::SomeException) -> do cleanUp listenerTid+ handle (\(e::SomeException) -> do cleanUp lTid let selfErr = "*** hArduino" `isInfixOf` show e hPutStrLn stderr $ if selfErr then dropWhile (== '\n') (show e)@@ -65,7 +68,7 @@ ++ concatMap ("\n*** " ++) [ "Make sure your Arduino is connected to " ++ fp , "And StandardFirmata is running on it!" ]) $- S.withSerial fp S.defaultSerialSettings{S.commSpeed = S.CS57600} $ \port -> do+ S.withSerial fp S.defaultSerialSettings{S.commSpeed = S.CS57600} $ \curPort -> do let initBoardState = BoardState { boardCapabilities = BoardCapabilities M.empty , analogReportingPins = S.empty@@ -78,28 +81,28 @@ dc <- newChan let initState = ArduinoState { message = debugger- , bailOut = bailOut listenerTid- , port = port+ , bailOut = bailOutF lTid+ , port = curPort , firmataID = "Unknown" , capabilities = BoardCapabilities M.empty , boardState = bs , deviceChannel = dc- , listenerTid = listenerTid+ , listenerTid = lTid } res <- tryJust catchCtrlC $ runStateT controller initState case res of Left () -> putStrLn "hArduino: Caught Ctrl-C, quitting.." _ -> return ()- cleanUp listenerTid+ cleanUp lTid where catchCtrlC UserInterrupt = Just () catchCtrlC _ = Nothing+ cleanUp tid = do mbltid <- tryTakeMVar tid- case mbltid of- Just t -> killThread t- _ -> return ()- bailOut tid m ms = do cleanUp tid- error $ "\n*** hArduino:ERROR: " ++ intercalate "\n*** " (m:ms)+ maybe (pure ()) killThread mbltid + bailOutF tid m ms = do cleanUp tid+ error $ "\n*** hArduino:ERROR: " ++ intercalate "\n*** " (m:ms)+ -- | Send down a request. send :: Request -> Arduino () send req = do debug $ "Sending: " ++ show req ++ " <" ++ unwords (map showByte (B.unpack p)) ++ ">"@@ -163,9 +166,9 @@ return bst{ pinStates = M.insert p PinData{pinMode = ANALOG, pinValue = Just (Right v)} (pinStates bst) } DigitalMessage p l h -> do dbg $ "Updating digital port " ++ show p ++ " values with " ++ showByteList [l,h] modifyMVar_ bs $ \bst -> do- let upd o od | p /= pinPort o = od -- different port, no change- | pinMode od `notElem` [INPUT] = od -- not an input pin, ignore- | True = od{pinValue = Just (Left newVal)}+ let upd o od | p /= pinPort o = od -- different port, no change+ | pinMode od /= INPUT = od -- not an input pin, ignore+ | True = od{pinValue = Just (Left newVal)} where idx = pinPortIndex o newVal | idx <= 6 = l `testBit` fromIntegral idx | True = h `testBit` fromIntegral (idx - 7)@@ -195,17 +198,20 @@ -- To accommodate for the case when standard-Firmata may not be running, -- we will time out after 10 seconds of waiting, which should be plenty mbTo <- handshake QueryFirmware (Just (5000000 :: Int))- (\r -> case r of {Firmware{} -> True; _ -> False})+ (\case Firmware{} -> True+ _ -> False) (\(Firmware v1 v2 m) -> modify (\s -> s{firmataID = "Firmware v" ++ show v1 ++ "." ++ show v2 ++ "(" ++ m ++ ")"})) case mbTo of Nothing -> return False -- timed out Just () -> do -- Step 3: Send a capabilities request _ <- handshake CapabilityQuery Nothing- (\r -> case r of {Capabilities{} -> True; _ -> False})+ (\case Capabilities{} -> True+ _ -> False) (\(Capabilities c) -> modify (\s -> s{capabilities = c})) -- Step 4: Send analog-mapping query _ <- handshake AnalogMappingQuery Nothing- (\r -> case r of {AnalogMapping{} -> True; _ -> False})+ (\case AnalogMapping{} -> True+ _ -> False) (\(AnalogMapping as) -> do BoardCapabilities m <- gets capabilities -- need to put capabilities to both outer and inner state let caps = BoardCapabilities (M.mapWithKey (mapAnalog as) m)
System/Hardware/Arduino/Data.hs view
@@ -12,6 +12,9 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-}++{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+ module System.Hardware.Arduino.Data where import Control.Concurrent (Chan, MVar, modifyMVar, modifyMVar_, withMVar, ThreadId)@@ -28,10 +31,12 @@ import System.Hardware.Arduino.Utils +import System.Exit (exitFailure)+ -- | A port (containing 8 pins)-data Port = Port { portNo :: Word8 -- ^ The port number- }- deriving (Eq, Ord)+newtype Port = Port { portNo :: Word8 -- ^ The port number+ }+ deriving (Eq, Ord) -- | Show instance for Port instance Show Port where@@ -49,7 +54,7 @@ show (MixedPin w) = "Pin" ++ show w -- | A pin on the Arduino, as viewed by the library; i.e., real-pin numbers-data IPin = InternalPin { pinNo :: Word8 }+newtype IPin = InternalPin { pinNo :: Word8 } deriving (Eq, Ord) -- | Show instance for IPin@@ -208,14 +213,14 @@ -- | State of the computation data ArduinoState = ArduinoState {- message :: String -> IO () -- ^ Current debugging routine- , bailOut :: forall a. String -> [String] -> IO a -- ^ Clean-up and quit with a hopefully informative message- , port :: SerialPort -- ^ Serial port we are communicating on- , firmataID :: String -- ^ The ID of the board (as identified by the Board itself)- , boardState :: MVar BoardState -- ^ Current state of the board- , deviceChannel :: Chan Response -- ^ Incoming messages from the board- , capabilities :: BoardCapabilities -- ^ Capabilities of the board- , listenerTid :: MVar ThreadId -- ^ ThreadId of the listener+ message :: String -> IO () -- ^ Current debugging routine+ , bailOut :: String -> [String] -> IO () -- ^ Clean-up and quit with a hopefully informative message+ , port :: SerialPort -- ^ Serial port we are communicating on+ , firmataID :: String -- ^ The ID of the board (as identified by the Board itself)+ , boardState :: MVar BoardState -- ^ Current state of the board+ , deviceChannel :: Chan Response -- ^ Incoming messages from the board+ , capabilities :: BoardCapabilities -- ^ Capabilities of the board+ , listenerTid :: MVar ThreadId -- ^ ThreadId of the listener } -- | The Arduino monad.@@ -230,7 +235,8 @@ -- | Bailing out: print the given string on stdout and die die :: String -> [String] -> Arduino a die m ms = do f <- gets bailOut- liftIO $ f m ms+ liftIO $ do f m ms+ exitFailure -- | Which modes does this pin support? getPinModes :: IPin -> Arduino [PinMode]@@ -247,8 +253,9 @@ err <- gets bailOut liftIO $ withMVar bs $ \bst -> case p `M.lookup` pinStates bst of- Nothing -> err ("Trying to access " ++ show p ++ " without proper configuration.")- ["Make sure that you use 'setPinMode' to configure this pin first."]+ Nothing -> do err ("Trying to access " ++ show p ++ " without proper configuration.")+ ["Make sure that you use 'setPinMode' to configure this pin first."]+ exitFailure Just pd -> return pd -- | Given a pin, collect the digital value corresponding to the
System/Hardware/Arduino/Firmata.hs view
@@ -9,7 +9,8 @@ -- Implementation of the firmata protocol ------------------------------------------------------------------------------- -{-# LANGUAGE NamedFieldPuns #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+ module System.Hardware.Arduino.Firmata where import Control.Concurrent (newEmptyMVar, readMVar, withMVar, modifyMVar_, threadDelay)@@ -172,8 +173,8 @@ -- -- NB. As of March 2 2013; StandardFirmata that's distributed with the Arduino-App does /not/ support the Pulse-In command. -- However, there is a patch to add this command; see: <http://github.com/rwldrn/johnny-five/issues/18> for details.--- If you want to use hArduino's 'pulseIn' command, then you /have/ to install the above patch. Also see the function--- 'pulseIn_hostOnly', which works with the distributed StandardFirmata: It implements a version that is not as+-- If you want to use hArduino's @pulseIn@ command, then you /have/ to install the above patch. Also see the function+-- @pulseIn_hostOnly@, which works with the distributed StandardFirmata: It implements a version that is not as -- accurate in its timing, but might be sufficient if high precision is not required. pulse :: Pin -> Bool -> Int -> Maybe Int -> Arduino (Maybe Int) pulse p' v duration mbTo = do
System/Hardware/Arduino/Parts/LCD.hs view
@@ -16,6 +16,9 @@ ------------------------------------------------------------------------------------------------- {-# LANGUAGE NamedFieldPuns #-}++{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+ module System.Hardware.Arduino.Parts.LCD( -- * LCD types and registration LCD, LCDController(..), lcdRegister@@ -54,6 +57,8 @@ import qualified System.Hardware.Arduino.Utils as U +import System.Exit (exitFailure)+ --------------------------------------------------------------------------------------- -- Low level interface, not available to the user ---------------------------------------------------------------------------------------@@ -117,7 +122,8 @@ bs <- gets boardState err <- gets bailOut liftIO $ withMVar bs $ \bst -> case lcd `M.lookup` lcds bst of- Nothing -> err ("hArduino: Cannot locate " ++ show lcd) []+ Nothing -> do err ("hArduino: Cannot locate " ++ show lcd) []+ exitFailure Just ld -> return $ lcdController ld -- | Send a command to the LCD controller@@ -265,7 +271,8 @@ , LCDData {lcdDisplayControl = newC, lcdDisplayMode = newM, lcdController = c}) <- liftIO $ modifyMVar bs $ \bst -> case lcd `M.lookup` lcds bst of- Nothing -> err ("hArduino: Cannot locate " ++ show lcd) []+ Nothing -> do err ("hArduino: Cannot locate " ++ show lcd) []+ exitFailure Just ld@LCDData{lcdDisplayControl, lcdDisplayMode} -> do let ld' = ld { lcdDisplayControl = f lcdDisplayControl , lcdDisplayMode = g lcdDisplayMode@@ -395,14 +402,15 @@ -- > lcdCreateSymbol :: LCD -> [String] -> Arduino LCDSymbol lcdCreateSymbol lcd glyph- | length glyph /= 8 || any (/= 5) (map length glyph)+ | length glyph /= 8 || any ((/= 5) . length) glyph = die "hArduino: lcdCreateSymbol: Invalid glyph description: must be 8x5!" ("Received:" : glyph) | True = do bs <- gets boardState err <- gets bailOut (i, c) <- liftIO $ modifyMVar bs $ \bst -> case lcd `M.lookup` lcds bst of- Nothing -> err ("hArduino: Cannot locate " ++ show lcd) []+ Nothing -> do err ("hArduino: Cannot locate " ++ show lcd) []+ exitFailure Just ld@LCDData{lcdGlyphCount, lcdController} -> do let ld' = ld { lcdGlyphCount = lcdGlyphCount + 1 } return (bst{lcds = M.insert lcd ld' (lcds bst)}, (lcdGlyphCount, lcdController))
System/Hardware/Arduino/Parts/Piezo.hs view
@@ -9,7 +9,6 @@ -- Abstractions for piezo speakers. ------------------------------------------------------------------------------------------------- -{-# LANGUAGE NamedFieldPuns #-} module System.Hardware.Arduino.Parts.Piezo( -- * Declaring a piezo speaker Piezo, speaker
System/Hardware/Arduino/Protocol.hs view
@@ -9,6 +9,8 @@ -- Internal representation of the firmata protocol. ------------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+ module System.Hardware.Arduino.Protocol(package, unpackageSysEx, unpackageNonSysEx) where import Data.Word (Word8)
System/Hardware/Arduino/SamplePrograms/Counter.hs view
@@ -9,6 +9,8 @@ -- Demonstrates using two push-buttons to count up and down. ------------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+ module System.Hardware.Arduino.SamplePrograms.Counter where import Control.Monad.Trans (liftIO)@@ -16,8 +18,8 @@ import System.Hardware.Arduino -- | Two push-button switches, controlling a counter value. We will increment--- the counter if the first one ('bUp') is pressed, and decrement the value if the--- second one ('bDown') is pressed. We also have a led connected to pin 13 (either use+-- the counter if the first one (@bUp@) is pressed, and decrement the value if the+-- second one (@bDown@) is pressed. We also have a led connected to pin 13 (either use -- the internal or connect an external one), that we light up when the counter value -- is 0. --@@ -37,7 +39,7 @@ update curVal = do liftIO $ print curVal digitalWrite led (curVal == 0)- [up, down] <- waitAnyHigh [bUp, bDown]+ ~[up, down] <- waitAnyHigh [bUp, bDown] let newVal = case (up, down) of (True, True) -> curVal -- simultaneous press (True, False) -> curVal+1
System/Hardware/Arduino/SamplePrograms/LCD.hs view
@@ -9,6 +9,8 @@ -- Basic demo of an Hitachi HD44780 LCD ------------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+ module System.Hardware.Arduino.SamplePrograms.LCD where import Control.Monad.Trans (liftIO)
System/Hardware/Arduino/SamplePrograms/SevenSegment.hs view
@@ -25,7 +25,7 @@ -- | Connections for the Texas Instruments 74HC595 shift-register. Datasheet: <http://www.ti.com/lit/ds/symlink/sn74hc595.pdf>. -- In our circuit, we merely use pins 8 thru 12 on the Arduino to control the 'serial', 'enable', 'rClock', 'sClock', and 'nClear'--- lines, respectively. Since we do not need to read the output of the shift-register, we leave the 'bits' field unconnected.+-- lines, respectively. Since we do not need to read the output of the shift-register, we leave the 'mbBits' field unconnected. sr :: SR_74HC595 sr = SR_74HC595 { serial = digital 8 , nEnable = digital 9
hArduino.cabal view
@@ -1,13 +1,14 @@+Cabal-Version: 2.2 Name: hArduino-Version: 1.1+Version: 1.2 Category: Hardware Synopsis: Control your Arduino board from Haskell. Description: hArduino allows Haskell programs to control Arduino boards (<http://www.arduino.cc>) and peripherals, using the Firmata protocol (<http://firmata.org>). .- For details, see: <http://leventerkok.github.com/hArduino>.+ For details, see: <http://leventerkok.github.io/hArduino>. Copyright: Levent Erkok, 2013-2014-License: BSD3+License: BSD-3-Clause License-file: LICENSE Stability: Experimental Author: Levent Erkok@@ -15,8 +16,9 @@ Bug-reports: http://github.com/LeventErkok/hArduino/issues Maintainer: Levent Erkok (erkokl@gmail.com) Build-Type: Simple-Cabal-Version: >= 1.14 Extra-Source-Files: INSTALL, README.md, COPYRIGHT, CHANGES.md++Tested-With : GHC==8.10.2, GHC==8.8.4 source-repository head type: git