diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -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 diff --git a/System/Hardware/Arduino/Comm.hs b/System/Hardware/Arduino/Comm.hs --- a/System/Hardware/Arduino/Comm.hs +++ b/System/Hardware/Arduino/Comm.hs @@ -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) diff --git a/System/Hardware/Arduino/Data.hs b/System/Hardware/Arduino/Data.hs --- a/System/Hardware/Arduino/Data.hs +++ b/System/Hardware/Arduino/Data.hs @@ -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 diff --git a/System/Hardware/Arduino/Firmata.hs b/System/Hardware/Arduino/Firmata.hs --- a/System/Hardware/Arduino/Firmata.hs +++ b/System/Hardware/Arduino/Firmata.hs @@ -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: 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 diff --git a/System/Hardware/Arduino/Parts/LCD.hs b/System/Hardware/Arduino/Parts/LCD.hs --- a/System/Hardware/Arduino/Parts/LCD.hs +++ b/System/Hardware/Arduino/Parts/LCD.hs @@ -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)) diff --git a/System/Hardware/Arduino/Parts/Piezo.hs b/System/Hardware/Arduino/Parts/Piezo.hs --- a/System/Hardware/Arduino/Parts/Piezo.hs +++ b/System/Hardware/Arduino/Parts/Piezo.hs @@ -9,7 +9,6 @@ -- Abstractions for piezo speakers. ------------------------------------------------------------------------------------------------- -{-# LANGUAGE NamedFieldPuns #-} module System.Hardware.Arduino.Parts.Piezo( -- * Declaring a piezo speaker Piezo, speaker diff --git a/System/Hardware/Arduino/Protocol.hs b/System/Hardware/Arduino/Protocol.hs --- a/System/Hardware/Arduino/Protocol.hs +++ b/System/Hardware/Arduino/Protocol.hs @@ -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) diff --git a/System/Hardware/Arduino/SamplePrograms/Counter.hs b/System/Hardware/Arduino/SamplePrograms/Counter.hs --- a/System/Hardware/Arduino/SamplePrograms/Counter.hs +++ b/System/Hardware/Arduino/SamplePrograms/Counter.hs @@ -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 diff --git a/System/Hardware/Arduino/SamplePrograms/LCD.hs b/System/Hardware/Arduino/SamplePrograms/LCD.hs --- a/System/Hardware/Arduino/SamplePrograms/LCD.hs +++ b/System/Hardware/Arduino/SamplePrograms/LCD.hs @@ -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) diff --git a/System/Hardware/Arduino/SamplePrograms/SevenSegment.hs b/System/Hardware/Arduino/SamplePrograms/SevenSegment.hs --- a/System/Hardware/Arduino/SamplePrograms/SevenSegment.hs +++ b/System/Hardware/Arduino/SamplePrograms/SevenSegment.hs @@ -25,7 +25,7 @@ -- | Connections for the Texas Instruments 74HC595 shift-register. Datasheet: . -- 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 diff --git a/hArduino.cabal b/hArduino.cabal --- a/hArduino.cabal +++ b/hArduino.cabal @@ -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 () and peripherals, using the Firmata protocol (). . - For details, see: . + For details, see: . 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