obd 0.1.0.0 → 0.2.0.0
raw patch · 10 files changed
+312/−133 lines, 10 filesdep ~basenew-component:exe:obd-example
Dependency ranges changed: base
Files
- app/Example.hs +38/−0
- app/Terminal.hs +19/−19
- obd.cabal +12/−1
- src/System/Hardware/ELM327.hs +14/−9
- src/System/Hardware/ELM327/Car.hs +119/−30
- src/System/Hardware/ELM327/Car/MAP.hs +17/−15
- src/System/Hardware/ELM327/Connection.hs +59/−35
- src/System/Hardware/ELM327/Connection/OBD.hs +20/−22
- src/System/Hardware/ELM327/Simulator.hs +2/−2
- src/System/Hardware/ELM327/Utils/Monad.hs +12/−0
+ app/Example.hs view
@@ -0,0 +1,38 @@+module Main where++import Control.Exception (bracket)+import Control.Lens ((^.))+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Class (lift)++import System.Hardware.ELM327 (connect)+import System.Hardware.ELM327.Commands (AT(..), Protocol(..))+import System.Hardware.ELM327.Connection (Con, ConT, ConError, withCon, close', at)+import System.Hardware.ELM327.Car (Car, runCarT, defaultCar)+import qualified System.Hardware.ELM327.Car as Car++main :: IO ()+main = do+ r <- bracket (either (fail . show) return =<< connect "/dev/ttyUSB0")+ (\c -> putStrLn "Closing connection..." >> close' c)+ query+ either (fail . show) return r++query :: Con -> IO (Either ConError ())+query con = withCon con $ runCarT $ do+ _ <- lift $ at (ATSelectProtocol AutomaticProtocol)+ printI "ECT" $ car ^. Car.engineCoolantTemperature+ printI "Fuel Rate" $ car ^. Car.engineFuelRate+ printI "RPM" $ car ^. Car.engineRPM+ printI "Air T." $ car ^. Car.intakeAirTemperature+ printI "MAP" $ car ^. Car.intakeManifoldAbsolutePressure+ printI "MAF" $ car ^. Car.massAirFlowRate+ printI "Throttle" $ car ^. Car.throttlePosition+ printI "Speed" $ car ^. Car.vehicleSpeed+ where+ car :: Car (ConT IO)+ car = defaultCar+ printI key value = do+ v <- show <$> value+ liftIO $ putStrLn $ key ++ ": " ++ v+
app/Terminal.hs view
@@ -4,7 +4,6 @@ import Control.Exception (bracket) import Control.Monad (join) import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Reader (MonadReader, ReaderT, runReaderT, ask) import Control.Monad.Trans.Class (lift) import Data.List (isSuffixOf) import qualified Data.ByteString.Char8 as Char8@@ -20,7 +19,7 @@ controlIO, runInputT, defaultSettings, getInputLine) -import System.Hardware.ELM327.Connection (Con, recv, sendString)+import System.Hardware.ELM327.Connection (Con, ConT, ConError, withCon, recv, sendString) import System.Hardware.ELM327.Simulator (defaultSimulator) import System.Hardware.ELM327.Simulator.OBDBus.VWPolo2007 (stoppedCarBus) import qualified System.Hardware.ELM327.Connection as Connection@@ -28,10 +27,10 @@ import qualified System.Hardware.ELM327.Simulator as Simulator -newtype Term a = Term { runTerm :: ReaderT Con IO a }- deriving (Functor, Applicative, Monad, MonadIO, MonadReader Con)+newtype TermT a = TermT { runTermT :: ConT IO a }+ deriving (Functor, Applicative, Monad, MonadIO) -instance MonadException Term where+instance MonadException TermT where controlIO f = join . liftIO $ f (RunIO return) data ConnectionType = ConnectionTypeActualDevice FilePath@@ -51,36 +50,37 @@ p = helper <*> connectionType connect :: ConnectionType -> IO Con-connect ConnectionTypeSimulator = Simulator.connect $ defaultSimulator stoppedCarBus-connect (ConnectionTypeActualDevice dev) = ELM327.connect dev+connect ConnectionTypeSimulator = Simulator.connect (defaultSimulator stoppedCarBus)+connect (ConnectionTypeActualDevice dev) = either (\e -> fail $ "could not connect: " ++ show e) return =<< ELM327.connect dev runTerminal :: ConnectionType -> IO ()-runTerminal ct = bracket (connect ct)- (\c -> putStrLn "Closing connection..." >> Connection.close c)- (liftIO . runTerminalWithConnection)+runTerminal ct = do+ r <- bracket (connect ct)+ (\c -> putStrLn "Closing connection..." >> Connection.close' c)+ (liftIO . runTerminalWithConnection)+ either (\e -> fail $ "error: " ++ show e) return r -runTerminalWithConnection :: Con -> IO ()-runTerminalWithConnection = runReaderT (runTerm readEvalPrint)+runTerminalWithConnection :: Con -> IO (Either ConError ())+runTerminalWithConnection con = withCon con (runTermT readEvalPrint) -readEvalPrint :: Term ()+readEvalPrint :: TermT () readEvalPrint = runInputT defaultSettings loop where- loop :: InputT Term ()+ loop :: InputT TermT () loop = do maybeLine <- getInputLine "% " case maybeLine of Nothing -> return () Just ":exit" -> return () Just x -> handleLine x >> loop -handleLine :: String -> InputT Term ()+handleLine :: String -> InputT TermT () handleLine cmd = do- con <- lift ask- liftIO $ sendString con $ cmd ++ "\r"+ lift $ TermT . sendString $ cmd ++ "\r" printAll -printAll :: InputT Term ()+printAll :: InputT TermT () printAll = do- maybeBS <- lift ask >>= liftIO . recv+ maybeBS <- lift $ TermT recv case maybeBS of Nothing -> return () Just b -> liftIO . putStrLn $ convertResponse b where
obd.cabal view
@@ -1,5 +1,5 @@ name: obd-version: 0.1.0.0+version: 0.2.0.0 synopsis: Communicate to OBD interfaces over ELM327 description: Haskell library to communicate with OBD-II over ELM327,@@ -58,6 +58,17 @@ , haskeline >= 0.7.2.3 && < 0.8 , mtl >= 2.2.1 && < 2.3 , optparse-applicative >= 0.12.1.0 && < 0.13+ , transformers >= 0.4.2.0 && < 0.5+ default-language: Haskell2010+ default-extensions: OverloadedStrings++executable obd-example+ hs-source-dirs: app+ main-is: Example.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends: base+ , obd+ , lens >= 4.13 && < 4.14 , transformers >= 0.4.2.0 && < 0.5 default-language: Haskell2010 default-extensions: OverloadedStrings
src/System/Hardware/ELM327.hs view
@@ -15,24 +15,27 @@ import qualified System.Hardware.Serialport as Port import System.Hardware.ELM327.Commands (AT(..))-import System.Hardware.ELM327.Connection (Con(..), at)+import System.Hardware.ELM327.Connection (Con(..), ConError, withCon, at) -- | Connect to an ELM327 device.-connect :: FilePath -> IO Con+connect :: FilePath -> IO (Either ConError Con) connect fp = do let s = SerialPortSettings { commSpeed = CS38400 , bitsPerWord = 8 , stopb = One , parity = NoParity , flowControl = NoFlowControl- , timeout = 2 }+ , timeout = 5 {- 500ms -} } port <- openSerial fp s is <- makeInputStream (produce port) os <- makeOutputStream (consume port)- initialize $ Con is os (closeSerial port)+ initialize $ Con is os where- produce port = Just <$> Port.recv port 8- consume _ Nothing = return ()+ produce port = do+ b <- Port.recv port 8+ if Char8.null b then return Nothing+ else return $ Just b+ consume port Nothing = closeSerial port consume port (Just x) = sendAll port x sendAll port bs@@ -41,6 +44,8 @@ sendAll port $ Char8.drop sent bs initialize con = do- _ <- at con ATResetAll- _ <- at con ATEchoOff- return con+ v <- withCon con $ do+ _ <- at ATResetAll+ _ <- at ATEchoOff+ return ()+ return (v >> return con)
src/System/Hardware/ELM327/Car.hs view
@@ -1,45 +1,134 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RankNTypes #-} -- | A generic car data type-module System.Hardware.ELM327.Car where+module System.Hardware.ELM327.Car (+ -- * Base car structure+ Car+, defaultCar + -- * Monad transformer for cashing+, CarT(..)+, runCarT+, flushCache+, cache++ -- * Lenses for 'Car'+, engineCoolantTemperature+, engineFuelRate+, engineRPM+, intakeAirTemperature+, intakeManifoldAbsolutePressure+, massAirFlowRate+, throttlePosition+, vehicleSpeed++ -- * Internal structure+, CarState+, emptyState+) where++import Control.Concurrent.STM (TVar, atomically, newTVarIO, readTVar, writeTVar, modifyTVar)+import Control.Lens (Lens', lens, (^.), (.~)) import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans.Either (EitherT(..), runEitherT)+import Control.Monad.Reader (ReaderT, MonadReader, runReaderT, ask)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.Trans.Maybe (MaybeT(..)) import Numeric.Units.Dimensional.Prelude -import System.Hardware.ELM327.Connection (Con)-import System.Hardware.ELM327.Errors (OBDError)+import System.Hardware.ELM327.Connection (ConT) import qualified System.Hardware.ELM327.Connection.OBD as OBD --- | Some info about the car.-type I m a = m (Either OBDError a)+-- | A car that has some properties, see lenses documentation below.+data Car m = Car { _engineCoolantTemperature :: CarT m (ThermodynamicTemperature Double)+ , _engineFuelRate :: CarT m (VolumeFlow Double)+ , _engineRPM :: CarT m (Frequency Double)+ , _intakeAirTemperature :: CarT m (ThermodynamicTemperature Double)+ , _intakeManifoldAbsolutePressure :: CarT m (Pressure Double)+ , _massAirFlowRate :: CarT m (MassFlow Double)+ , _throttlePosition :: CarT m Double+ , _vehicleSpeed :: CarT m (Velocity Double) } --- | A monad transform for information about the car.-infoT :: I m a -> EitherT OBDError m a-infoT = EitherT+-- | A monad transformer for 'Car' where requested data is cached until 'flushCache' is called.+newtype CarT m a = CarT { runCarT' :: ReaderT (TVar CarState) m a }+ deriving (Functor, Applicative, Monad, MonadIO, MonadReader (TVar CarState), MonadTrans) --- | Run the monad transform for inforamtion about the ar.-runInfoT :: EitherT OBDError m a -> I m a-runInfoT = runEitherT+-- | Run a 'CarT' with an initial empty state+runCarT :: MonadIO m => CarT m a -> m a+runCarT action = liftIO (newTVarIO emptyState) >>= runReaderT (runCarT' action) --- | A car that has some properties.-data Car m = Car { engineCoolantTemperature :: I m (ThermodynamicTemperature Double)- , engineFuelRate :: I m (VolumeFlow Double)- , engineRPM :: I m (Frequency Double)- , intakeAirTemperature :: I m (ThermodynamicTemperature Double)- , intakeManifoldAbsolutePressure :: I m (Pressure Double)- , massAirFlowRate :: I m (MassFlow Double)- , throttlePosition :: I m Double- , vehicleSpeed :: I m (Velocity Double) }+-- | Flush the cache of a 'CarT'+flushCache :: MonadIO m => CarT m ()+flushCache = ask >>= liftIO . atomically . flip writeTVar emptyState +-- | Make an action cachable in 'CarT'+cache :: MonadIO m => (forall n . Lens' (Car n) (CarT n a)) -> CarT m a -> CarT m a+cache property action = do+ mv <- runCarT . (^. property) <$> (ask >>= liftIO . atomically . readTVar)+ v <- liftIO $ runMaybeT mv+ case v of+ Just x -> return x+ Nothing -> do+ v' <- action+ ask >>= liftIO . atomically . flip modifyTVar (property .~ lift (MaybeT . return $ Just v'))+ return v'+ -- | The default car, that uses straight forward OBD commands to get -- most of the data.-defaultCar :: MonadIO m => Con -> Car m-defaultCar c = Car { engineCoolantTemperature = liftIO $ OBD.engineCoolantTemperature c- , engineFuelRate = liftIO $ OBD.engineFuelRate c- , engineRPM = liftIO $ OBD.engineRPM c- , intakeAirTemperature = liftIO $ OBD.intakeAirTemperature c- , intakeManifoldAbsolutePressure = liftIO $ OBD.intakeManifoldAbsolutePressure c- , massAirFlowRate = liftIO $ OBD.massAirFlowRate c- , throttlePosition = liftIO $ OBD.throttlePosition c- , vehicleSpeed = liftIO $ OBD.vehicleSpeed c }+defaultCar :: MonadIO m => Car (ConT m)+defaultCar = Car { _engineCoolantTemperature = cache engineCoolantTemperature (lift OBD.engineCoolantTemperature)+ , _engineFuelRate = cache engineFuelRate (lift OBD.engineFuelRate)+ , _engineRPM = cache engineRPM (lift OBD.engineRPM)+ , _intakeAirTemperature = cache intakeAirTemperature (lift OBD.intakeAirTemperature)+ , _intakeManifoldAbsolutePressure = cache intakeManifoldAbsolutePressure (lift OBD.intakeManifoldAbsolutePressure)+ , _massAirFlowRate = cache massAirFlowRate (lift OBD.massAirFlowRate)+ , _throttlePosition = cache throttlePosition (lift OBD.throttlePosition)+ , _vehicleSpeed = cache vehicleSpeed (lift OBD.vehicleSpeed) }++-- | The engine coolant temperature of the car.+engineCoolantTemperature :: Lens' (Car m) (CarT m (ThermodynamicTemperature Double))+engineCoolantTemperature = lens _engineCoolantTemperature $ \c x -> c { _engineCoolantTemperature = x }++-- | The engine fuel rate of the car.+engineFuelRate :: Lens' (Car m) (CarT m (VolumeFlow Double))+engineFuelRate = lens _engineFuelRate $ \c x -> c { _engineFuelRate = x }++-- | The engine RPM of the car.+engineRPM :: Lens' (Car m) (CarT m (Frequency Double))+engineRPM = lens _engineRPM $ \c x -> c { _engineRPM = x }++-- | The intake air temperature of the car.+intakeAirTemperature :: Lens' (Car m) (CarT m (ThermodynamicTemperature Double))+intakeAirTemperature = lens _intakeAirTemperature $ \c x -> c { _intakeAirTemperature = x }++-- | The intake manifold absolute pressure of the car.+intakeManifoldAbsolutePressure :: Lens' (Car m) (CarT m (Pressure Double))+intakeManifoldAbsolutePressure = lens _intakeManifoldAbsolutePressure $ \c x -> c { _intakeManifoldAbsolutePressure = x }++-- | The mass air flow rate of the car.+massAirFlowRate :: Lens' (Car m) (CarT m (MassFlow Double))+massAirFlowRate = lens _massAirFlowRate $ \c x -> c { _massAirFlowRate = x }++-- | The throttle position of the car.+throttlePosition :: Lens' (Car m) (CarT m Double)+throttlePosition = lens _throttlePosition $ \c x -> c { _throttlePosition = x }++-- | The throttle position of the car.+vehicleSpeed :: Lens' (Car m) (CarT m (Velocity Double))+vehicleSpeed = lens _vehicleSpeed $ \c x -> c { _vehicleSpeed = x }++-- | The pure state of the car, with possibly missing values.+type CarState = Car (MaybeT IO)++-- | The empty 'CarState'+emptyState :: CarState+emptyState = Car { _engineCoolantTemperature = lift (MaybeT $ return Nothing)+ , _engineFuelRate = lift (MaybeT $ return Nothing)+ , _engineRPM = lift (MaybeT $ return Nothing)+ , _intakeAirTemperature = lift (MaybeT $ return Nothing)+ , _intakeManifoldAbsolutePressure = lift (MaybeT $ return Nothing)+ , _massAirFlowRate = lift (MaybeT $ return Nothing)+ , _throttlePosition = lift (MaybeT $ return Nothing)+ , _vehicleSpeed = lift (MaybeT $ return Nothing) }
src/System/Hardware/ELM327/Car/MAP.hs view
@@ -2,17 +2,19 @@ -- | A car that uses the intake manifold absolute pressure (MAP) to -- calculate fuel consumption. module System.Hardware.ELM327.Car.MAP (- MAPProperties+ MAPProperties(..) , defaultProperties , mapCar ) where +import Control.Lens ((^. ), (.~)) import Control.Monad.IO.Class (MonadIO) import Numeric.Units.Dimensional.Prelude -import System.Hardware.ELM327.Connection (Con)-import System.Hardware.ELM327.Car (Car(..), I, infoT, runInfoT, defaultCar)+import System.Hardware.ELM327.Connection (ConT)+import System.Hardware.ELM327.Car (CarT, Car, defaultCar)+import qualified System.Hardware.ELM327.Car as Car -- | Some fixed values needed to implement a MAP car.@@ -31,19 +33,19 @@ -- | Create a car that uses the intake manifold absolute pressure (MAP) -- to calculate fuel consumption.-mapCar :: MonadIO m => Con -> MAPProperties ->Car m-mapCar con p = let c = defaultCar con in- c { engineFuelRate = engineFuelRate' p c- , massAirFlowRate = massAirFlowRate' p c}+mapCar :: MonadIO m => MAPProperties -> Car (ConT m)+mapCar p = (\c -> (Car.massAirFlowRate .~ massAirFlowRate' p c) c) .+ (\c -> (Car.engineFuelRate .~ engineFuelRate' p c) c) $+ defaultCar -- | Calculate MAF from RPM, MAP and IAT -- -- See https://web.archive.org/web/20160323073219/http://www.lightner.net/obd2guru/IMAP_AFcalc.html-massAirFlowRate' :: Monad m => MAPProperties -> Car m -> I m (MassFlow Double)-massAirFlowRate' p c = runInfoT $ do- rpm <- infoT $ engineRPM c- map' <- infoT $ intakeManifoldAbsolutePressure c- iat <- infoT $ intakeAirTemperature c+massAirFlowRate' :: Monad m => MAPProperties -> Car m -> CarT m (MassFlow Double)+massAirFlowRate' p c = do+ rpm <- c ^. Car.engineRPM+ map' <- c ^. Car.intakeManifoldAbsolutePressure+ iat <- c ^. Car.intakeAirTemperature let imap = rpm * map' / iat / (2 *~ one) let voleff = volumetricEfficiency p let displ = engineDisplacement p@@ -52,7 +54,7 @@ return $ imap * voleff * displ * mm / r -- | Calculate the engine fuel rate from MAF-engineFuelRate' :: Monad m => MAPProperties -> Car m -> I m (VolumeFlow Double)-engineFuelRate' p c = runInfoT $ do- maf <- infoT $ massAirFlowRate' p c+engineFuelRate' :: Monad m => MAPProperties -> Car m -> CarT m (VolumeFlow Double)+engineFuelRate' p c = do+ maf <- c ^. Car.massAirFlowRate return $ maf / airFuelRatio p / fuelMassDensity p
src/System/Hardware/ELM327/Connection.hs view
@@ -1,7 +1,13 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-} -- | Basic interface for communication with the ELM327. module System.Hardware.ELM327.Connection where import Control.Lens (re, (^.), (^?))+import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader (ReaderT, MonadReader, runReaderT, ask)+ import Data.ByteString.Char8 (ByteString) import Data.Char (isHexDigit) import Data.List (stripPrefix)@@ -22,73 +28,91 @@ OBDDecodeError(..), obdErrorMessage) import System.Hardware.ELM327.Utils.Hex (hexToBytes)-import System.Hardware.ELM327.Utils.Monad (maybeToLeft, maybeToRight)+import System.Hardware.ELM327.Utils.Monad (maybeToExcept, orThrow) -- | A connection to an ELM327 device that can be closed.-data Con = Con (InputStream ByteString) (OutputStream ByteString) (IO ())+data Con = Con { conInput :: InputStream ByteString+ , conOutput :: OutputStream ByteString } +-- | Monad transformer for connection operations.+newtype ConT m a = ConT { runConT :: ReaderT Con (ExceptT ConError m) a }+ deriving (Functor, Applicative, Monad, MonadIO, MonadReader Con, MonadError ConError)++-- | Run a 'ConT'+withCon :: Con -> ConT m a -> m (Either ConError a)+withCon con = runExceptT . flip runReaderT con . runConT++-- | Errors that can occur in the 'ConT' monad.+data ConError = ConOBDError OBDError+ | ConTimeoutError+ deriving (Show)+ -- | Close the connection-close :: Con -> IO ()-close (Con _ _ c) = c+close :: MonadIO m => ConT m ()+close = ask >>= close' +-- | Close the connection+close' :: MonadIO m => Con -> m ()+close' = liftIO . Streams.write Nothing . conOutput+ -- | Send an ELM327 command.-send :: Con -> Command -> IO ()-send con cmd = do- sendString con $ cmd ^. re command- sendString con "\r"- flushOutputStream con+send :: MonadIO m => Command -> ConT m ()+send cmd = do+ sendString $ cmd ^. re command+ sendString "\r"+ flushOutputStream -- | Send all bytes to the ELM327.-sendBytes :: Con -> ByteString -> IO ()-sendBytes (Con _ os _) x = Streams.write (Just x) os+sendBytes :: MonadIO m => ByteString -> ConT m ()+sendBytes x = ask >>= liftIO . Streams.write (Just x) . conOutput -- | Send a string to the ELM327.-sendString :: Con -> String -> IO ()-sendString con = sendBytes con . Char8.pack+sendString :: MonadIO m => String -> ConT m ()+sendString = sendBytes . Char8.pack -- | Receive available ELM327 caracters as a byte string-recvRaw :: Con -> IO (Maybe ByteString)-recvRaw (Con is _ _) = Streams.read is+recvRaw :: MonadIO m => ConT m (Maybe ByteString)+recvRaw = ask >>= liftIO . Streams.read . conInput -- | Receive an ELM327 response as a byte string.-recv :: Con -> IO (Maybe ByteString)-recv (Con is _ _) = do+recv :: MonadIO m => ConT m (Maybe ByteString)+recv = do s <- Char8.concat . reverse <$> recv' [] if Char8.null s then return Nothing else return (Just s) where recv' xs = do- bs <- Streams.read is- case bs of Nothing -> recv' xs+ bs <- ask >>= liftIO . Streams.read . conInput+ case bs of Nothing -> throwError ConTimeoutError Just bs' -> handle' xs bs' handle' xs bs = let (pref, suf) = Char8.break (== '>') . Char8.filter (not . ignored) $ bs in if Char8.null suf then recv' (pref:xs)- else Streams.unRead (Char8.tail suf) is >> return (pref:xs)+ else do ask >>= liftIO . Streams.unRead (Char8.tail suf) . conInput+ return (pref:xs) ignored x = x == '\r' || x == '\0' -- | Flush the output stream of a connection.-flushOutputStream :: Con -> IO ()-flushOutputStream (Con _ os _) = Streams.write (Just "") os+flushOutputStream :: MonadIO m => ConT m ()+flushOutputStream = ask >>= liftIO. Streams.write (Just "") . conOutput -- | Send an 'AT' command and expect a response.-at :: Con -> AT -> IO (Maybe ByteString)-at con cmd = send con (AT cmd) >> recv con+at :: MonadIO m => AT -> ConT m (Maybe ByteString)+at cmd = send (AT cmd) >> recv -- | Send an 'OBD' comand and expect a response.-obd :: Con -> OBD -> IO (Either OBDError [Word8])-obd con cmd = do- send con (OBD cmd)- mbs <- recv con+obd :: MonadIO m => OBD -> ConT m [Word8]+obd cmd = do+ send (OBD cmd)+ mbs <- recv case mbs of- Nothing -> return $ Left (OBDDecodeError EmptyResponseError)- Just bs -> return . decode $ Char8.unpack bs+ Nothing -> throwError $ ConOBDError (OBDDecodeError EmptyResponseError)+ Just bs -> decode $ Char8.unpack bs where- decode bs = Right (removeStatusPrefixes bs)- >>= \x -> maybeToLeft x (OBDErrorMessage <$> x ^? obdErrorMessage)- >>= Right . filter isHexDigit- >>= maybeToRight (OBDDecodeError NotEnoughBytesError) . hexToBytes- >>= maybeToRight (OBDDecodeError NoResponseHeaderError) . stripHeader+ decode bs = let x = removeStatusPrefixes bs in+ filter isHexDigit <$> maybeToExcept (ConOBDError . OBDErrorMessage <$> x ^? obdErrorMessage) x+ >>= (`orThrow` ConOBDError (OBDDecodeError NotEnoughBytesError)) . hexToBytes+ >>= (`orThrow` ConOBDError (OBDDecodeError NoResponseHeaderError)) . stripHeader statusPrefixes = ["SEARCHING..."] removeStatusPrefixes x = foldl stripPrefix' x statusPrefixes
src/System/Hardware/ELM327/Connection/OBD.hs view
@@ -1,65 +1,63 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Rank2Types #-} -- | Send OBD requests to the connection and return a quantity. module System.Hardware.ELM327.Connection.OBD where import Control.Lens (Iso', re, (^.))-import Control.Monad.Trans.Either (EitherT(..), left)+import Control.Monad.Except (throwError)+import Control.Monad.IO.Class (MonadIO) import Numeric.Units.Dimensional.Prelude import System.Hardware.ELM327.Commands (OBD(..), CurrentData(..))-import System.Hardware.ELM327.Connection (Con)+import System.Hardware.ELM327.Connection (ConT, ConError(..)) import System.Hardware.ELM327.Errors (OBDError(..), OBDDecodeError(..)) import qualified System.Hardware.ELM327.Connection as Connection import qualified System.Hardware.ELM327.OBD.Conversion as C ---- | Type alias for a request.-type Request a = Con -> IO (Either OBDError a)- -- | Get the engine coolant temperature.-engineCoolantTemperature :: Request (ThermodynamicTemperature Double)+engineCoolantTemperature :: MonadIO m => ConT m (ThermodynamicTemperature Double) engineCoolantTemperature = getOneByte OBDEngineCoolantTemperature C.engineCoolantTemperature -- | Get the engine fuel rate.-engineFuelRate :: Request (VolumeFlow Double)+engineFuelRate :: MonadIO m => ConT m (VolumeFlow Double) engineFuelRate = getTwoBytes OBDEngineFuelRate C.engineFuelRate -- | Get the engine RPM.-engineRPM :: Request (Frequency Double)+engineRPM :: MonadIO m => ConT m (Frequency Double) engineRPM = getTwoBytes OBDEngineRPM C.engineRPM -- | Get the intake air temperature.-intakeAirTemperature :: Request (ThermodynamicTemperature Double)+intakeAirTemperature :: MonadIO m => ConT m (ThermodynamicTemperature Double) intakeAirTemperature = getOneByte OBDIntakeAirTemperature C.intakeAirTemperature -- | Get the intake manifold absolute pressure-intakeManifoldAbsolutePressure :: Request (Pressure Double)+intakeManifoldAbsolutePressure :: MonadIO m => ConT m (Pressure Double) intakeManifoldAbsolutePressure = getOneByte OBDIntakeManifoldAbsolutePressure C.intakeManifoldAbsolutePressure -- | Get mass air flow rate.-massAirFlowRate :: Request (MassFlow Double)+massAirFlowRate :: MonadIO m => ConT m (MassFlow Double) massAirFlowRate = getTwoBytes OBDMassAirFlowRate C.massAirFlowRate -- | Get throttle position.-throttlePosition :: Request Double+throttlePosition :: MonadIO m => ConT m Double throttlePosition = getOneByte OBDThrottlePosition C.throttlePosition -- | Get vehicle speed.-vehicleSpeed :: Request (Velocity Double)+vehicleSpeed :: MonadIO m => ConT m (Velocity Double) vehicleSpeed = getOneByte OBDVehicleSpeed C.vehicleSpeed -- | Get one byte of data and convert it.-getOneByte :: CurrentData -> Iso' a C.OneByte -> Request a-getOneByte cmd conv con = runEitherT $ (^. re conv) <$> (oneByte =<< obd)- where obd = EitherT $ Connection.obd con (CurrentData cmd)+getOneByte :: MonadIO m => CurrentData -> Iso' a C.OneByte -> ConT m a+getOneByte cmd conv = (^. re conv) <$> (oneByte =<< obd)+ where obd = Connection.obd (CurrentData cmd) oneByte [x] = return x- oneByte _ = left $ OBDDecodeError NotEnoughBytesError+ oneByte _ = throwError $ ConOBDError (OBDDecodeError NotEnoughBytesError) -- | Get two bytes of data and convert it.-getTwoBytes :: CurrentData -> Iso' a C.TwoBytes -> Request a-getTwoBytes cmd conv con = runEitherT $ (^. re conv) <$> (twoBytes =<< obd)- where obd = EitherT $ Connection.obd con (CurrentData cmd)+getTwoBytes :: MonadIO m => CurrentData -> Iso' a C.TwoBytes -> ConT m a+getTwoBytes cmd conv = (^. re conv) <$> (twoBytes =<< obd)+ where obd = Connection.obd (CurrentData cmd) twoBytes [x, y] = return (x, y)- twoBytes _ = left $ OBDDecodeError NotEnoughBytesError+ twoBytes _ = throwError $ ConOBDError (OBDDecodeError NotEnoughBytesError)
src/System/Hardware/ELM327/Simulator.hs view
@@ -83,10 +83,10 @@ is <- makeInputStream (produce c) os <- makeOutputStream (consume c) _ <- forkIO . void $ runStateT (runSimulator c) s- return $ Con is os (atomically $ closeTMChan (_conInputBuffer c))+ return $ Con is os where produce = atomically . readTMChan . _conOutputBuffer- consume _ Nothing = return ()+ consume c Nothing = atomically $ closeTMChan (_conInputBuffer c) consume c (Just x) = atomically $ writeTMChan (_conInputBuffer c) x runSimulator :: OBDBus bus => SimCon bus -> StateT (Simulator bus) IO ()
src/System/Hardware/ELM327/Utils/Monad.hs view
@@ -1,6 +1,8 @@ -- | Collection of helper functions to deal with monads. module System.Hardware.ELM327.Utils.Monad where +import Control.Monad.Except (MonadError, throwError)+ -- | Convert 'Maybe a' to 'Either a b'. maybeToLeft :: b -> Maybe a -> Either a b maybeToLeft _ (Just x) = Left x@@ -10,3 +12,13 @@ maybeToRight :: b -> Maybe a -> Either b a maybeToRight _ (Just x) = Right x maybeToRight x Nothing = Left x++-- | Convert 'Maybe a' to @throwError a@.+maybeToExcept :: MonadError e m => Maybe e -> a -> m a+maybeToExcept (Just x) _ = throwError x+maybeToExcept Nothing x = return x++-- | Throw an exception on 'Nothing'.+orThrow :: MonadError e m => Maybe a -> e -> m a+orThrow Nothing e = throwError e+orThrow (Just x) _ = return x