network-can 0.1.0.0 → 0.2.0.0

raw patch · 30 files changed

+1221/−1147 lines, 30 filesdep +data-defaultdep +io-classesdep −data-default-classdep −mtldep −transformersnew-component:exe:readmePVP ok

version bump matches the API change (PVP)

Dependencies added: data-default, io-classes

Dependencies removed: data-default-class, mtl, transformers, unliftio

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• README.lhs +30/−0
• README.md +5/−4
• app/CANBridge.hs +7/−8
• app/CANDump.hs +7/−13
• app/SLCANSerial.hs +11/−10
• app/SLCANUDP.hs +11/−10
• network-can.cabal +74/−30
• src-slcan/Network/SLCAN.hs +168/−0
• src-slcan/Network/SLCAN/Builder.hs +146/−0
• src-slcan/Network/SLCAN/Parser.hs +179/−0
• src-slcan/Network/SLCAN/Types.hs +129/−0
• src-socketcan/Network/SocketCAN.hs +96/−0
• src-socketcan/Network/SocketCAN/Bindings.hsc +79/−0
• src-socketcan/Network/SocketCAN/Example.hs +41/−0
• src-socketcan/Network/SocketCAN/LowLevel.hs +62/−0
• src-socketcan/Network/SocketCAN/Translate.hs +77/−0
• src/Network/CAN.hs +19/−2
• src/Network/CAN/Class.hs +0/−39
• src/Network/CAN/Types.hs +42/−3
• src/Network/SLCAN.hs +0/−193
• src/Network/SLCAN/Builder.hs +0/−146
• src/Network/SLCAN/Parser.hs +0/−179
• src/Network/SLCAN/Types.hs +0/−129
• src/Network/SocketCAN.hs +0/−122
• src/Network/SocketCAN/Bindings.hsc +0/−79
• src/Network/SocketCAN/Example.hs +0/−41
• src/Network/SocketCAN/LowLevel.hs +0/−62
• src/Network/SocketCAN/Translate.hs +0/−77
• test/CANSpec.hs +21/−0

@@ -1,3 +1,20 @@+# Version [0.2.0.0](https://github.com/DistRap/network-can/compare/0.1.0.0...0.2.0.0) (2026-04-29)++* Split `slcan` and `socketcan` into public sublibraries+* Migrate to `io-classes` and switch from `MonadCAN` typeclass+  to `CAN` handle (record of functions style):++  ```+  data CAN m = CAN+  { canSend :: CANMessage -> m ()+  , canRecv :: m CANMessage+  }+  ```+* Runners renamed+  * `runSocketCAN` is now `withSocketCAN`+  * `runSLCAN` is now `withSLCAN`+  to reflect the handle change+ # Version [0.1.0.0](https://github.com/DistRap/network-can/compare/d50564...0.1.0.0) (2025-05-19)  * Initial release

@@ -0,0 +1,30 @@+# network-can++[![GitHub Workflow Status](https://img.shields.io/github/actions/workflow/status/DistRap/network-can/ci.yaml?branch=main)](https://github.com/DistRap/network-can/actions/workflows/ci.yaml)+[![Hackage version](https://img.shields.io/hackage/v/network-can.svg?color=success)](https://hackage.haskell.org/package/network-can)++CAN bus networking using Linux SocketCAN or SLCAN backends.++## Usage++```haskell+import qualified Control.Monad+import qualified Network.CAN+import qualified Network.SocketCAN++main :: IO ()+main = do+  Network.SocketCAN.withSocketCAN+    (Network.SocketCAN.mkCANInterface "vcan0")+    $ \can -> do+        Network.CAN.send+          can+          $ Network.CAN.standardMessage+              0x123+              [0xDE, 0xAD]++        Control.Monad.forever+          $ Network.CAN.recv+              can+            >>= putStrLn . Network.CAN.prettyCANMessage+```

@@ -9,21 +9,22 @@  ```haskell import qualified Control.Monad-import qualified Control.Monad.IO.Class import qualified Network.CAN import qualified Network.SocketCAN  main :: IO () main = do-  Network.SocketCAN.runSocketCAN+  Network.SocketCAN.withSocketCAN     (Network.SocketCAN.mkCANInterface "vcan0")-    $ do+    $ \can -> do         Network.CAN.send+          can           $ Network.CAN.standardMessage               0x123               [0xDE, 0xAD]          Control.Monad.forever           $ Network.CAN.recv-            >>= Control.Monad.IO.Class.liftIO . print+              can+            >>= putStrLn . Network.CAN.prettyCANMessage ```

@@ -1,8 +1,8 @@ {-# LANGUAGE LambdaCase #-} module Main where -import Control.Monad.Trans (MonadTrans(lift))-import Data.Default.Class (Default(def))+import Control.Monad.Class.MonadAsync (race_)+import Data.Default (Default(def)) import Network.SLCAN (Transport(..)) import System.Hardware.Serialport (CommSpeed(..), SerialPortSettings(..)) @@ -11,7 +11,6 @@ import qualified Network.SocketCAN import qualified Network.SLCAN import qualified System.Hardware.Serialport-import qualified UnliftIO.Async  -- | Bridge vcan0 to slcan over /dev/can4discouart serial port main :: IO ()@@ -21,12 +20,12 @@     (System.Hardware.Serialport.defaultSerialSettings       { commSpeed = CS115200 }     )-  Network.SLCAN.runSLCAN (Transport_Handle h) def $ do-    Network.SocketCAN.runSocketCAN (Network.SocketCAN.mkCANInterface "vcan0") $ do-        UnliftIO.Async.race_+  Network.SLCAN.withSLCAN (Transport_Handle h) def $ \slcan -> do+    Network.SocketCAN.withSocketCAN (Network.SocketCAN.mkCANInterface "vcan0") $ \socketcan -> do+        race_           (Control.Monad.forever-           $ Network.CAN.recv >>= lift . Network.CAN.send+           $ Network.CAN.recv slcan >>= Network.CAN.send socketcan           )           (Control.Monad.forever-           $ lift Network.CAN.recv >>= Network.CAN.send+           $ Network.CAN.recv socketcan >>= Network.CAN.send slcan           )

@@ -1,22 +1,16 @@ module Main where  import qualified Control.Monad-import qualified Control.Monad.IO.Class import qualified Network.CAN import qualified Network.SocketCAN  main :: IO () main = do-  Network.SocketCAN.runSocketCAN+  Network.SocketCAN.withSocketCAN     (Network.SocketCAN.mkCANInterface "vcan0")-    (Control.Monad.forever-       $ Network.CAN.recv-         >>= Control.Monad.IO.Class.liftIO . print-    )---- needs Network.CAN.Pretty or Builder or smthing--- that does the same ID formatting as SLCAN.Builder:78--- a la--- $ candump -e vcan0---  vcan0  001237E5   [2]  4C EE---  vcan0       7E5   [2]  4C EE+    $ \can ->+      (Control.Monad.forever+         $ Network.CAN.recv+             can+           >>= putStrLn . Network.CAN.prettyCANMessage+      )

@@ -1,9 +1,9 @@ module Main where -import Control.Monad.IO.Class-import Data.Default.Class (Default(def))+import Control.Monad.Class.MonadSay (MonadSay(say))+import Data.Default (Default(def)) import System.Hardware.Serialport (CommSpeed(..), SerialPortSettings(..))-import Network.CAN (MonadCAN)+import Network.CAN (CAN) import Network.SLCAN (Transport(..))  import qualified Control.Monad@@ -23,18 +23,18 @@         { commSpeed = CS115200 }       ) -  Network.SLCAN.runSLCAN+  Network.SLCAN.withSLCAN     (Transport_Handle h)     def     act  act-  :: ( MonadCAN m-     , MonadIO m-     )-  => m ()-act = do+  :: MonadSay m+  => CAN m+  -> m ()+act can = do   Network.CAN.send+    can     $ Network.CAN.standardMessage         -- vendorID SDO         0x601@@ -42,4 +42,5 @@    Control.Monad.forever     $ Network.CAN.recv-      >>= Control.Monad.IO.Class.liftIO . print+        can+      >>= say . Network.CAN.prettyCANMessage

@@ -1,8 +1,8 @@ module Main where -import Control.Monad.IO.Class-import Data.Default.Class (Default(def))-import Network.CAN (MonadCAN)+import Control.Monad.Class.MonadSay (MonadSay(say))+import Data.Default (Default(def))+import Network.CAN (CAN) import Network.SLCAN (Transport(..)) import Network.Socket (AddrInfo(..), SocketType(Datagram)) @@ -36,7 +36,7 @@         sock         (addrAddress ourAddrinfo) -      Network.SLCAN.runSLCAN+      Network.SLCAN.withSLCAN         (Transport_UDP sock (addrAddress targetAddrinfo))         def         act@@ -44,16 +44,17 @@     (_, _) -> error "getAddrInfo fail"  act-  :: ( MonadCAN m-     , MonadIO m-     )-  => m ()-act = do+  :: MonadSay m+  => CAN m+  -> m ()+act can = do   Network.CAN.send+    can     $ Network.CAN.standardMessage         0x7E5         [0x4C]    Control.Monad.forever     $ Network.CAN.recv-      >>= Control.Monad.IO.Class.liftIO . print+        can+      >>= say . Network.CAN.prettyCANMessage

@@ -1,6 +1,6 @@-cabal-version:       2.2+cabal-version:       3.0 name:                network-can-version:             0.1.0.0+version:             0.2.0.0 synopsis:            CAN bus networking description:         Talk to CAN buses using Linux SocketCAN and SLCAN homepage:            https://github.com/DistRap/network-can@@ -25,97 +25,141 @@   description:     Build example applications +flag build-readme+  default:+    False+  description:+    Build readme example++common commons+  ghc-options:         -Wall -Wunused-packages+  default-language:    Haskell2010++common execs+  ghc-options:         -threaded+                       -rtsopts+                       "-with-rtsopts -N"+ library-  ghc-options:         -Wall+  import:              commons   hs-source-dirs:      src   exposed-modules:     Network.CAN-                       Network.CAN.Class                        Network.CAN.Types-                       Network.SLCAN+  build-depends:       base >= 4.7 && < 5+                     , QuickCheck++library slcan+  import:              commons+  visibility:          public+  hs-source-dirs:      src-slcan+  exposed-modules:     Network.SLCAN                        Network.SLCAN.Builder                        Network.SLCAN.Parser                        Network.SLCAN.Types-                       Network.SocketCAN-                       Network.SocketCAN.Bindings-                       Network.SocketCAN.Example-                       Network.SocketCAN.LowLevel-                       Network.SocketCAN.Translate-   build-depends:       base >= 4.7 && < 5                      , attoparsec >= 0.14                      , bytestring                      , containers-                     , data-default-class-                     , mtl+                     , data-default+                     , io-classes                      , network >= 3.1+                     , network-can                      , QuickCheck-                     , transformers-                     , unliftio +library socketcan+  import:              commons+  visibility:          public+  hs-source-dirs:      src-socketcan+  exposed-modules:     Network.SocketCAN+                       Network.SocketCAN.Bindings+                       Network.SocketCAN.Example+                       Network.SocketCAN.LowLevel+                       Network.SocketCAN.Translate+  build-depends:       base >= 4.7 && < 5+                     , io-classes+                     , network >= 3.1+                     , network-can   build-tool-depends:  hsc2hs:hsc2hs-  default-language:    Haskell2010  test-suite pure   type:                exitcode-stdio-1.0   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N   hs-source-dirs:      test   main-is:             Spec.hs-  other-modules:       Samples+  other-modules:       CANSpec+                       Samples                        SLCANSpec                        SocketCANSpec   build-tool-depends:  hspec-discover:hspec-discover   build-depends:       base >= 4.7 && < 5                      , hspec                      , network-can+                     , network-can:slcan+                     , network-can:socketcan   default-language:    Haskell2010  executable hcandump+  import:              commons, execs   if !flag(build-apps)     buildable: False   build-depends:       base >=4.7 && <5                      , network-can-  default-language:    Haskell2010+                     , network-can:socketcan   main-is:             CANDump.hs   hs-source-dirs:      app-  ghc-options:         -Wall -threaded -rtsopts "-with-rtsopts -N"  executable hcanbridge+  import:              commons, execs   if !flag(build-apps)     buildable: False   build-depends:       base >=4.7 && <5                      , network-can-                     , data-default-class-                     , mtl+                     , network-can:slcan+                     , network-can:socketcan+                     , data-default+                     , io-classes                      , serialport >= 0.5.5-                     , unliftio-  default-language:    Haskell2010   main-is:             CANBridge.hs   hs-source-dirs:      app-  ghc-options:         -Wall -threaded -rtsopts "-with-rtsopts -N"  executable hslcanserial+  import:              commons, execs   if !flag(build-apps)     buildable: False   build-depends:       base >=4.7 && <5                      , network-can-                     , data-default-class+                     , network-can:slcan+                     , data-default+                     , io-classes                      , serialport >= 0.5.5-  default-language:    Haskell2010   main-is:             SLCANSerial.hs   hs-source-dirs:      app-  ghc-options:         -Wall -threaded -rtsopts "-with-rtsopts -N"  executable hslcanudp+  import:              commons, execs   if !flag(build-apps)     buildable: False   build-depends:       base >=4.7 && <5                      , network                      , network-can-                     , data-default-class-  default-language:    Haskell2010+                     , network-can:slcan+                     , data-default+                     , io-classes   main-is:             SLCANUDP.hs   hs-source-dirs:      app-  ghc-options:         -Wall -threaded -rtsopts "-with-rtsopts -N"++executable readme+  import:              commons, execs+  if !flag(build-readme)+    buildable: False+  build-depends:+      base >=4.7 && <5+    , network-can+    , network-can:socketcan+  build-tool-depends:+      markdown-unlit:markdown-unlit+  main-is: README.lhs+  ghc-options: -pgmL markdown-unlit -Wall  source-repository head   type:     git

@@ -0,0 +1,168 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}++module Network.SLCAN+  ( Transport(..)+  , withSLCANTransport+  , sendSLCANMessage+  , sendSLCANControl+  , recvSLCANMessage+  , sendCANMessage+  , module Network.SLCAN.Types+  , SLCANException(..)+  , withSLCAN+  ) where++import Control.Monad.Class.MonadThrow (Exception(..), MonadThrow(throwIO), finally)+import Control.Monad.IO.Class (MonadIO(..))++import Network.Socket (Socket, SockAddr)+import Network.CAN (CANMessage, CAN(..))+import Network.SLCAN.Types+import System.IO (Handle)++import qualified Control.Monad+import qualified Data.ByteString+import qualified Data.ByteString.Char8+import qualified System.IO+import qualified Network.SLCAN.Builder+import qualified Network.SLCAN.Parser+import qualified Network.Socket.ByteString++data Transport =+    Transport_Handle Handle+  | Transport_UDP Socket SockAddr++withSLCANTransport+  :: ( MonadIO m+     , MonadThrow m+     )+  => Transport+  -> SLCANConfig+  -> (Transport -> m a)+  -> m a+withSLCANTransport transport SLCANConfig{..} act = do+  let sendC = sendSLCANControl transport+  finally+    (do+       sendC SLCANControl_Close+       sendC (SLCANControl_Bitrate slCANConfigBitrate)+       Control.Monad.when+         slCANConfigResetErrors+         (sendC SLCANControl_ResetErrors)+       sendC+         (if slCANConfigListenOnly+          then SLCANControl_ListenOnly+          else SLCANControl_Open+         )++       act transport+    )+    (sendC SLCANControl_Close)++sendSLCANMessage+  :: MonadIO m+  => Transport+  -> SLCANMessage+  -> m ()+sendSLCANMessage (Transport_Handle handle) msg = liftIO $ do+  Control.Monad.void+    $ Data.ByteString.hPutStr+        handle+        $ Network.SLCAN.Builder.buildSLCANMessage+            msg+  System.IO.hFlush handle+sendSLCANMessage (Transport_UDP socket target) msg =+  liftIO+  $ Network.Socket.ByteString.sendAllTo+      socket+      (Network.SLCAN.Builder.buildSLCANMessage msg)+      target++sendSLCANControl+  :: MonadIO m+  => Transport+  -> SLCANControl+  -> m ()+sendSLCANControl t =+  sendSLCANMessage t+  . SLCANMessage_Control++recvSLCANMessage+  :: Transport+  -> IO (Either String SLCANMessage)+recvSLCANMessage (Transport_Handle handle) = do+  Network.SLCAN.Parser.parseSLCANMessage+  <$> hGetTillCR handle++  where+    hGetTillCR h = do+      msg <-+        Data.ByteString.hGetSome+          h+          1024+      if Data.ByteString.Char8.last msg == '\r'+      then pure msg+      else hGetTillCR h >>= pure . (msg <>)++recvSLCANMessage (Transport_UDP socket _target) = do+  Network.SLCAN.Parser.parseSLCANMessage+  <$> sockGetTillCR socket+  where+    sockGetTillCR s = do+      (msg, _source) <-+        Network.Socket.ByteString.recvFrom+          s+          1024+      if Data.ByteString.Char8.last msg == '\r'+      then pure msg+      else sockGetTillCR s >>= pure . (msg <>)++sendCANMessage+  :: Transport+  -> CANMessage+  -> IO ()+sendCANMessage t =+  sendSLCANMessage t+  . SLCANMessage_Data++data SLCANException = SLCANException_ParseError String+    deriving Show++instance Exception SLCANException++withSLCAN+  :: ( MonadIO m+     , MonadThrow m+     )+  => Transport+  -> SLCANConfig+  -> (CAN m -> m a)+  -> m a+withSLCAN transport config act = do+  withSLCANTransport+    transport+    config+    $ \t ->+        act+          CAN+            { canSend = liftIO . sendCANMessage t+            , canRecv =+                let+                  recv =+                    liftIO+                      (recvSLCANMessage t)+                    >>= \case+                      Left e ->+                        throwIO $ SLCANException_ParseError e+                      Right (SLCANMessage_Data cm) ->+                        pure cm+                      Right _other ->+                        -- TODO: do something with+                        -- SLCANMessage_Error+                        -- and SLCANMessage_State+                        -- like allow registering handlers for these+                        -- or throwIO on _Error one+                        recv+                in recv+            }

@@ -0,0 +1,146 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}++module Network.SLCAN.Builder+  ( buildSLCANMessage+  ) where++import Data.ByteString (ByteString)+import Data.ByteString.Builder (Builder)+import Data.Set (Set)+import Network.CAN.Types (CANArbitrationField(..), CANMessage(..))+import Network.SLCAN.Types+  ( SLCANMessage(..)+  , SLCANControl(..)+  , SLCANState(..)+  , SLCANCounters(..)+  , SLCANError(..)+  )+import qualified Data.Bits+import qualified Data.Set+import qualified Data.ByteString.Lazy+import qualified Data.ByteString.Builder++slCANBuilder+  :: SLCANMessage+  -> Builder+slCANBuilder slcanMsg =+  case slcanMsg of+    SLCANMessage_Control ctrlMsg -> slCANControlBuilder ctrlMsg+    SLCANMessage_Data canMsg -> slCANDataBuilder canMsg+    SLCANMessage_State state counters  -> slCANStateBuilder state counters+    SLCANMessage_Error errs -> slCANErrorBuilder errs+  <> Data.ByteString.Builder.char7 '\r'++slCANControlBuilder+  :: SLCANControl+  -> Builder+slCANControlBuilder SLCANControl_Open =+  Data.ByteString.Builder.char7 'O'+slCANControlBuilder SLCANControl_Close =+  Data.ByteString.Builder.char7 'C'+slCANControlBuilder (SLCANControl_Bitrate bitrate) =+     Data.ByteString.Builder.char7 'S'+  <> Data.ByteString.Builder.intDec+      (fromEnum bitrate)+slCANControlBuilder SLCANControl_ResetErrors =+  Data.ByteString.Builder.char7 'F'+slCANControlBuilder SLCANControl_ListenOnly =+  Data.ByteString.Builder.char7 'L'++slCANDataBuilder+  :: CANMessage+  -> Builder+slCANDataBuilder CANMessage{..} =+     arbitrationId canMessageArbitrationField+  <> Data.ByteString.Builder.word8Hex+      (fromIntegral $ length canMessageData)+  <> mconcat+      (map+         Data.ByteString.Builder.word8HexFixed+         canMessageData+      )++arbitrationId+  :: CANArbitrationField+  -> Builder+arbitrationId CANArbitrationField{..} =+     Data.ByteString.Builder.char7+       (case ( canArbitrationFieldExtended+             , canArbitrationFieldRTR+             )+        of+         (False, False) -> 't'+         (False, True)  -> 'r'+         (True, False)  -> 'T'+         (True, True)   -> 'R'+       )+  <> (if canArbitrationFieldExtended+      then Data.ByteString.Builder.word32HexFixed+      else+        (\word11 ->+           Data.ByteString.Builder.word8Hex+            (fromIntegral (word11 `Data.Bits.shiftR` 8))+        <> Data.ByteString.Builder.word8HexFixed+            (fromIntegral word11)+        )+     )+     canArbitrationFieldID++slCANStateBuilder+  :: SLCANState+  -> SLCANCounters+  -> Builder+slCANStateBuilder state SLCANCounters{..} =+     Data.ByteString.Builder.char7 's'+  <> Data.ByteString.Builder.char7+      (case state of+         SLCANState_Active -> 'a'+         SLCANState_Warning -> 'w'+         SLCANState_Passive -> 'p'+         SLCANState_BusOff -> 'b'+      )+  <> word16Dec3 slCANCountersTxErrors+  <> word16Dec3 slCANCountersRxErrors+  where+    -- encode as 3 bytes (maximum of 999 and zero padded)+    word16Dec3 x =+           (case x of+              _ | x < 10 -> Data.ByteString.Builder.string7 "00"+              _ | x < 100 -> Data.ByteString.Builder.char7 '0'+              _ | otherwise -> mempty+           )+        <> Data.ByteString.Builder.word16Dec+            (min 999 x)++slCANErrorBuilder+  :: Set SLCANError+  -> Builder+slCANErrorBuilder errs =+     Data.ByteString.Builder.char7 'e'+  <> Data.ByteString.Builder.word8Hex+      (fromIntegral $ Data.Set.size errs)+  <> mconcat+      (map+         ( Data.ByteString.Builder.char7+         . \case+             SLCANError_Ack -> 'a'+             SLCANError_Bit0 -> 'b'+             SLCANError_Bit1 -> 'B'+             SLCANError_CRC -> 'c'+             SLCANError_Form -> 'f'+             SLCANError_RxOverrun -> 'o'+             SLCANError_TxOverrun -> 'O'+             SLCANError_Stuff -> 's'+         )+         $ Data.Set.toList+             errs+      )++buildSLCANMessage+  :: SLCANMessage+  -> ByteString+buildSLCANMessage =+   Data.ByteString.Lazy.toStrict+ . Data.ByteString.Builder.toLazyByteString+ . slCANBuilder

@@ -0,0 +1,179 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}++module Network.SLCAN.Parser+  ( parseSLCANMessage+  ) where++import Data.Attoparsec.ByteString.Char8 (Parser)+import Data.Bits (Bits)+import Data.ByteString (ByteString)+import Data.Set (Set)+import Control.Applicative ((<|>))+import Network.CAN.Types (CANArbitrationField(..), CANMessage(..))+import Network.SLCAN.Types+  ( SLCANMessage(..)+  , SLCANControl(..)+  , SLCANBitrate+  , SLCANState(..)+  , SLCANCounters(..)+  , SLCANError(..)+  )++import qualified Data.Attoparsec.ByteString.Char8+import qualified Data.Set+import qualified Control.Monad++slCANParser :: Parser SLCANMessage+slCANParser = do+  Data.Attoparsec.ByteString.Char8.peekChar'+    >>= \case+      c | Data.Attoparsec.ByteString.Char8.inClass "OCSFL" c ->+        (SLCANMessage_Control <$> slCANControlParser)+      c | Data.Attoparsec.ByteString.Char8.inClass "tTrR" c ->+        (SLCANMessage_Data <$> slCANDataParser)+      's' ->+        Data.Attoparsec.ByteString.Char8.char 's'+        *> (SLCANMessage_State <$> slCANStateParser <*> slCANCountersParser)+      'e' ->+        Data.Attoparsec.ByteString.Char8.char 'e'+        *> (SLCANMessage_Error <$> slCANErrorParser)+      c | otherwise ->+        fail $ "Unknown SLCAN message type: " <> show c+  <* Data.Attoparsec.ByteString.Char8.char '\r'++slCANControlParser :: Parser SLCANControl+slCANControlParser = do+  Data.Attoparsec.ByteString.Char8.anyChar+  >>= \case+    'O' -> pure SLCANControl_Open+    'C' -> pure SLCANControl_Close+    'S' -> (SLCANControl_Bitrate <$> bitrate)+    'F' -> pure SLCANControl_ResetErrors+    'L' -> pure SLCANControl_ListenOnly+    c   -> fail $ "Unknown control message char: " <> show c+  where+    bitrate = do+      d <- Data.Attoparsec.ByteString.Char8.decimal+      if d > fromEnum (maxBound :: SLCANBitrate)+      then fail+             $ "Bitrate out of bounds, got "+             <> show d+             <> "but maximum is "+             <> show (fromEnum (maxBound :: SLCANBitrate))+             <> " ("+             <> show  (maxBound :: SLCANBitrate)+             <> ")"+      else pure $ toEnum d++slCANDataParser :: Parser CANMessage+slCANDataParser = do+  canMessageArbitrationField <- arbitrationId+  msgLen <- hexadecimalWithLength 1+  canMessageData <-+    Control.Monad.replicateM msgLen (hexadecimalWithLength 2)+  pure CANMessage{..}++-- | Parse arbitration ID+-- * t => 11 bit data frame+-- * r => 11 bit RTR frame+-- * T => 29 bit data frame+-- * R => 29 bit RTR frame+arbitrationId :: Parser CANArbitrationField+arbitrationId = do+      Data.Attoparsec.ByteString.Char8.char 't' *> stdID False+  <|> Data.Attoparsec.ByteString.Char8.char 'r' *> stdID True+  <|> Data.Attoparsec.ByteString.Char8.char 'T' *> extID False+  <|> Data.Attoparsec.ByteString.Char8.char 'R' *> extID True++stdID+  :: Bool+  -> Parser CANArbitrationField+stdID isRTR = do+  canArbitrationFieldID+    <- hexadecimalWithLength 3++  let+    canArbitrationFieldExtended = False+    canArbitrationFieldRTR = isRTR++  pure CANArbitrationField{..}++extID+  :: Bool+  -> Parser CANArbitrationField+extID isRTR = do+  canArbitrationFieldID+    <- hexadecimalWithLength 8++  let+    canArbitrationFieldExtended = True+    canArbitrationFieldRTR = isRTR++  pure CANArbitrationField{..}++hexadecimalWithLength+  :: ( Bits a+     , Integral a+     )+  => Int+  -> Parser a+hexadecimalWithLength len =+  Data.Attoparsec.ByteString.Char8.take len+  >>=+  either+    fail+    pure+    . Data.Attoparsec.ByteString.Char8.parseOnly+        Data.Attoparsec.ByteString.Char8.hexadecimal++slCANStateParser :: Parser SLCANState+slCANStateParser =+  Data.Attoparsec.ByteString.Char8.anyChar+  >>= \case+    'a' -> pure SLCANState_Active+    'w' -> pure SLCANState_Warning+    'p' -> pure SLCANState_Passive+    'b' -> pure SLCANState_BusOff+    c   -> fail $ "Unknown state char: " <> show c++slCANCountersParser :: Parser SLCANCounters+slCANCountersParser = do+    slCANCountersTxErrors <- decimal3+    slCANCountersRxErrors <- decimal3+    pure $ SLCANCounters{..}+  where+    decimal3 =+      Data.Attoparsec.ByteString.Char8.take 3+      >>=+      either+        fail+        pure+        . Data.Attoparsec.ByteString.Char8.parseOnly+            Data.Attoparsec.ByteString.Char8.decimal++slCANErrorParser :: Parser (Set SLCANError)+slCANErrorParser = do+  len <- hexadecimalWithLength 1+  Data.Set.fromList+    <$> Control.Monad.replicateM len errorChar+  where+    errorChar =+      Data.Attoparsec.ByteString.Char8.anyChar+      >>= \case+        'a' -> pure SLCANError_Ack+        'b' -> pure SLCANError_Bit0+        'B' -> pure SLCANError_Bit1+        'c' -> pure SLCANError_CRC+        'f' -> pure SLCANError_Form+        'o' -> pure SLCANError_RxOverrun+        'O' -> pure SLCANError_TxOverrun+        's' -> pure SLCANError_Stuff+        c   -> fail $ "Unknown error char: " <> show c++parseSLCANMessage+  :: ByteString+  -> Either String SLCANMessage+parseSLCANMessage =+  Data.Attoparsec.ByteString.Char8.parseOnly+    slCANParser

@@ -0,0 +1,129 @@+{-# LANGUAGE NumericUnderscores #-}+module Network.SLCAN.Types+  ( SLCANMessage(..)+  , SLCANControl(..)+  , SLCANBitrate(..)+  , numericBitrate+  , SLCANState(..)+  , SLCANCounters(..)+  , SLCANError(..)+  , SLCANConfig(..)+  ) where++import Data.Default (Default(def))+import Data.Set (Set)+import Data.Word (Word16)+import Network.CAN.Types (CANMessage)+import Test.QuickCheck (Arbitrary(..))++import qualified Test.QuickCheck++data SLCANMessage+  = SLCANMessage_Control SLCANControl+  | SLCANMessage_Data CANMessage+  | SLCANMessage_State SLCANState SLCANCounters+  | SLCANMessage_Error (Set SLCANError)+  deriving (Eq, Ord, Show)++instance Arbitrary SLCANMessage where+  arbitrary = Test.QuickCheck.oneof+    [ SLCANMessage_Control <$> arbitrary+    , SLCANMessage_Data <$> arbitrary+    , SLCANMessage_State <$> arbitrary <*> arbitrary+    , SLCANMessage_Error <$> arbitrary+    ]++data SLCANControl+  = SLCANControl_Open+  | SLCANControl_Close+  | SLCANControl_Bitrate SLCANBitrate+  | SLCANControl_ResetErrors+  | SLCANControl_ListenOnly+  deriving (Eq, Ord, Show)++instance Arbitrary SLCANControl where+  arbitrary = Test.QuickCheck.oneof+    [ pure SLCANControl_Open+    , pure SLCANControl_Close+    , SLCANControl_Bitrate <$> arbitrary+    , pure SLCANControl_ResetErrors+    , pure SLCANControl_ListenOnly+    ]++data SLCANBitrate+  = SLCANBitrate_10K+  | SLCANBitrate_20K+  | SLCANBitrate_50K+  | SLCANBitrate_100K+  | SLCANBitrate_125K+  | SLCANBitrate_250K+  | SLCANBitrate_500K+  | SLCANBitrate_800K+  | SLCANBitrate_1M+  deriving (Bounded, Eq, Enum, Ord, Show)++instance Arbitrary SLCANBitrate where+  arbitrary = Test.QuickCheck.arbitraryBoundedEnum++instance Default SLCANBitrate where+  def = SLCANBitrate_1M++numericBitrate :: SLCANBitrate -> Int+numericBitrate SLCANBitrate_10K  =    10_000+numericBitrate SLCANBitrate_20K  =    20_000+numericBitrate SLCANBitrate_50K  =    50_000+numericBitrate SLCANBitrate_100K =   100_000+numericBitrate SLCANBitrate_125K =   125_000+numericBitrate SLCANBitrate_250K =   250_000+numericBitrate SLCANBitrate_500K =   500_000+numericBitrate SLCANBitrate_800K =   800_000+numericBitrate SLCANBitrate_1M   = 1_000_000++data SLCANState+  = SLCANState_Active+  | SLCANState_Warning+  | SLCANState_Passive+  | SLCANState_BusOff+  deriving (Bounded, Eq, Enum, Ord, Show)++instance Arbitrary SLCANState where+  arbitrary = Test.QuickCheck.arbitraryBoundedEnum++data SLCANCounters = SLCANCounters+  { slCANCountersRxErrors :: Word16+  , slCANCountersTxErrors :: Word16+  } deriving (Eq, Ord, Show)++instance Arbitrary SLCANCounters where+  arbitrary =+    SLCANCounters+      <$> Test.QuickCheck.choose (0, 999)+      <*> Test.QuickCheck.choose (0, 999)++data SLCANError+  = SLCANError_Ack+  | SLCANError_Bit0+  | SLCANError_Bit1+  | SLCANError_CRC+  | SLCANError_Form+  | SLCANError_RxOverrun+  | SLCANError_TxOverrun+  | SLCANError_Stuff+  deriving (Bounded, Eq, Enum, Ord, Show)++instance Arbitrary SLCANError where+  arbitrary = Test.QuickCheck.arbitraryBoundedEnum++data SLCANConfig = SLCANConfig+  { slCANConfigBitrate :: SLCANBitrate+  , slCANConfigResetErrors :: Bool+  , slCANConfigListenOnly :: Bool+  } deriving (Eq, Ord, Show)++instance Default SLCANConfig where+  def =+    SLCANConfig+    { slCANConfigBitrate = def+    , slCANConfigResetErrors = False+    , slCANConfigListenOnly = False+    }

@@ -0,0 +1,96 @@+module Network.SocketCAN+  ( withSocket+  , sendCANMessage+  , recvCANMessage+  , Network.Socket.ifNameToIndex+  , CANInterface+  , mkCANInterface+  , NoSuchInterface(..)+  , withSocketCAN+  ) where++import Network.CAN (CANMessage, CAN(..))+import Network.Socket (Socket)+import Network.SocketCAN.Bindings (SockAddrCAN(..))++import Control.Monad.Class.MonadThrow (Exception(..), MonadThrow(bracket, throwIO))+import Control.Monad.IO.Class (MonadIO(..))++import qualified Network.Socket (ifNameToIndex)+import qualified Network.SocketCAN.LowLevel+import qualified Network.SocketCAN.Translate++withSocket+  :: ( MonadIO m+     , MonadThrow m+     )+  => Int+  -> (Socket -> m a)+  -> m a+withSocket ifaceIdx act = do+  bracket+    (liftIO Network.SocketCAN.LowLevel.socket)+    (liftIO . Network.SocketCAN.LowLevel.close)+    (\canSock -> do+      liftIO+        $ Network.SocketCAN.LowLevel.bind+            canSock+            $ Network.SocketCAN.Bindings.SockAddrCAN+              $ fromIntegral ifaceIdx+      act canSock+    )++sendCANMessage+  :: Socket+  -> CANMessage+  -> IO ()+sendCANMessage canSock cm =+  Network.SocketCAN.LowLevel.send+    canSock+    (Network.SocketCAN.Translate.toSocketCANFrame cm)++recvCANMessage+  :: Socket+  -> IO CANMessage+recvCANMessage canSock =+  Network.SocketCAN.LowLevel.recv canSock+  >>= pure . Network.SocketCAN.Translate.fromSocketCANFrame++newtype CANInterface = CANInterface+  { unCANInterface :: String }+  deriving Eq++instance Show CANInterface where+  show = unCANInterface++mkCANInterface :: String -> CANInterface+mkCANInterface = CANInterface++data NoSuchInterface = NoSuchInterface+    deriving Show++instance Exception NoSuchInterface++withSocketCAN+  :: ( MonadIO m+     , MonadThrow m+     )+  => CANInterface+  -> (CAN m -> m a)+  -> m a+withSocketCAN interface act = do+  mIdx <-+    liftIO+    $ Network.Socket.ifNameToIndex (unCANInterface interface)++  case mIdx of+    Nothing -> throwIO NoSuchInterface+    Just idx ->+      withSocket+        idx+        $ \sock ->+            act+              CAN+                { canSend = liftIO . sendCANMessage sock+                , canRecv = liftIO $ recvCANMessage sock+                }

@@ -0,0 +1,79 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Network.SocketCAN.Bindings+  (+  -- * Network package compatibility+    SockAddrCAN(..)+  , pattern CAN_RAW+  -- * SocketCAN bindings+  , SocketCANArbitrationField(..)+  , SocketCANFrame(..)+  ) where++import Data.Word (Word8, Word16, Word32)+import Foreign.Storable (Storable(..))+import Foreign.Marshal.Array (peekArray, pokeArray)+import Foreign.Ptr (plusPtr)+import Network.Socket.Address (SocketAddress(..))+import Network.Socket (ProtocolNumber)++#include <linux/can.h>+#include <sys/socket.h>++-- | CAN Socket type+newtype SockAddrCAN = SockAddrCAN Word32+  deriving (Eq, Ord)++-- Word16+type CSaFamily = (#type sa_family_t)++instance SocketAddress SockAddrCAN where+  sizeOfSocketAddress (SockAddrCAN _) =+    #const sizeof(struct sockaddr_can)+  peekSocketAddress sap = do+    ifidx <- (#peek struct sockaddr_can, can_ifindex) sap+    return (SockAddrCAN ifidx)+  pokeSocketAddress p (SockAddrCAN ifIndex) = do+    (#poke struct sockaddr_can, can_family) p ((#const AF_CAN) :: CSaFamily)+    (#poke struct sockaddr_can, can_ifindex) p ifIndex++-- | CAN RAW protocol family of PF_CAN+pattern CAN_RAW :: ProtocolNumber+pattern CAN_RAW = #const CAN_RAW++-- | SocketCAN Arbitration field (CAN ID including RTR, EFF, ERR bits)+newtype SocketCANArbitrationField =+  SocketCANArbitrationField { unSocketCANArbitrationField :: Word32 }+  deriving (Eq, Ord, Show, Storable)++data SocketCANFrame = SocketCANFrame+  { socketCANFrameArbitrationField :: SocketCANArbitrationField+  , socketCANFrameLength :: Word8+  , socketCANFrameData   :: [Word8]+  } deriving Show++instance Storable SocketCANFrame where+  sizeOf ~_ = #const sizeof(struct can_frame)+  alignment ~_ = #alignment struct can_frame+  peek ptr = do+    socketCANFrameArbitrationField+      <- #{peek struct can_frame, can_id} ptr+    socketCANFrameLength+      <- #{peek struct can_frame, len} ptr+    socketCANFrameData <-+      peekArray+        (fromIntegral socketCANFrameLength)+        (#{ptr struct can_frame, data} ptr)+    pure+      $ SocketCANFrame{..}+  poke ptr SocketCANFrame{..} = do+    #{poke struct can_frame, can_id}+      ptr+      socketCANFrameArbitrationField+    #{poke struct can_frame, len}+      ptr+      socketCANFrameLength+    pokeArray+      (#{ptr struct can_frame, data} ptr)+      socketCANFrameData

@@ -0,0 +1,41 @@+module Network.SocketCAN.Example where++import Control.Monad (forever)+import Network.CAN+import Network.Socket (Socket)+import Network.SocketCAN++import qualified Network.Socket++example :: IO ()+example = do+  let interface = "vcan0"+  mIdx <- Network.Socket.ifNameToIndex interface+  case mIdx of+    Nothing -> error $ "Interface " <> interface <> " not found"+    Just idx ->+      withSocket idx act++act :: Socket -> IO ()+act sock = do+  sendCANMessage+    sock+    $ standardMessage+        0x123+        [0xDE, 0xAD]++  sendCANMessage+    sock+    $ CANMessage+        (extendedID 0x123456)+        [0xEE]++  sendCANMessage+    sock+    $ CANMessage+        (setRTR $ extendedID 0x123)+        [0xDE, 0xAD, 0x11]++  forever+    $ recvCANMessage sock+    >>= print

@@ -0,0 +1,62 @@+{-# LANGUAGE TypeApplications #-}+module Network.SocketCAN.LowLevel+  ( socket+  , bind+  , send+  , recv+  , module Network.Socket+  ) where++import Control.Monad (void)+import Foreign.Ptr (Ptr)+import Network.Socket (Family(AF_CAN), Socket, close)+import Network.SocketCAN.Bindings (SockAddrCAN(..), SocketCANFrame)++import qualified Foreign.Ptr+import qualified Foreign.Marshal.Alloc+import qualified Foreign.Storable+import qualified Network.Socket+import qualified Network.Socket.Address+import qualified Network.SocketCAN.Bindings++-- | Create raw CAN socket+socket+  :: IO Socket+socket =+  Network.Socket.socket+    AF_CAN+    Network.Socket.Raw+    Network.SocketCAN.Bindings.CAN_RAW++-- | Bind CAN socket+bind+  :: Socket+  -> SockAddrCAN+  -> IO ()+bind = Network.Socket.Address.bind++send+  :: Socket+  -> SocketCANFrame+  -> IO ()+send canSock cf =+  Foreign.Marshal.Alloc.alloca $ \ptr -> do+    Foreign.Storable.poke ptr cf+    void+      $ Network.Socket.sendBuf+          canSock+          (Foreign.Ptr.castPtr ptr)+          (Foreign.Storable.sizeOf cf)++recv+  :: Socket+  -> IO SocketCANFrame+recv canSock =+  Foreign.Marshal.Alloc.alloca $ \ptr -> do+    (_nBytes, _sockAddr) <-+      Network.Socket.Address.recvBufFrom+        @SockAddrCAN+        canSock+        (ptr :: Ptr SocketCANFrame)+        (Foreign.Storable.sizeOf (undefined :: SocketCANFrame))+    Foreign.Storable.peek ptr >>= pure

@@ -0,0 +1,77 @@+{-# LANGUAGE RecordWildCards #-}++-- | Translation between CANMessage and SocketCANFrame++module Network.SocketCAN.Translate+  ( toSocketCANFrame+  , fromSocketCANFrame+  ) where++import Data.Bits ((.&.), (.|.), shiftL)+import Data.Word (Word32)+import Network.CAN.Types (CANArbitrationField(..), CANMessage(..))+import Network.SocketCAN.Bindings (SocketCANArbitrationField(..), SocketCANFrame(..))+import qualified Data.Bool++toSocketCANFrame+  :: CANMessage+  -> SocketCANFrame+toSocketCANFrame CANMessage{..} =+  SocketCANFrame+  { socketCANFrameArbitrationField =+      toSocketCANArbitrationField+        canMessageArbitrationField+  , socketCANFrameLength =+      fromIntegral $ length canMessageData+  , socketCANFrameData = canMessageData+  }++fromSocketCANFrame+  :: SocketCANFrame+  -> CANMessage+fromSocketCANFrame SocketCANFrame{..} =+  CANMessage+  { canMessageArbitrationField =+      fromSocketCANArbitrationField+        socketCANFrameArbitrationField+  , canMessageData = socketCANFrameData+  }++toSocketCANArbitrationField+  :: CANArbitrationField+  -> SocketCANArbitrationField+toSocketCANArbitrationField CANArbitrationField{..} =+  SocketCANArbitrationField+  $ Data.Bool.bool+      id+      (.|. effBit)+      canArbitrationFieldExtended+  $ Data.Bool.bool+      id+      (.|. rtrBit)+      canArbitrationFieldRTR+  $ canArbitrationFieldID++fromSocketCANArbitrationField+  :: SocketCANArbitrationField+  -> CANArbitrationField+fromSocketCANArbitrationField (SocketCANArbitrationField scid) =+  let+    isEff = scid .&. effBit /= 0+  in+    CANArbitrationField+    { canArbitrationFieldID =+        Data.Bool.bool+          (.&. (1 `shiftL` 12 - 1))+          (.&. (1 `shiftL` 30 - 1))+          isEff+        $ scid+    , canArbitrationFieldExtended = isEff+    , canArbitrationFieldRTR = scid .&. rtrBit /= 0+    }++effBit :: Word32+effBit = 1 `shiftL` 31++rtrBit :: Word32+rtrBit = 1 `shiftL` 30

@@ -1,7 +1,24 @@ module Network.CAN-  ( module Network.CAN.Class+  ( CAN(..)+  , send+  , recv   , module Network.CAN.Types   ) where -import Network.CAN.Class import Network.CAN.Types++data CAN m = CAN+  { canSend :: CANMessage -> m ()+  , canRecv :: m CANMessage+  }++send+  :: CAN m+  -> CANMessage+  -> m ()+send = canSend++recv+  :: CAN m+  -> m CANMessage+recv = canRecv

@@ -1,39 +0,0 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeOperators #-}-module Network.CAN.Class-  ( MonadCAN(..)-  ) where--import Control.Monad.Trans (MonadTrans, lift)-import Control.Monad.Trans.Except (ExceptT)-import Control.Monad.Trans.Reader (ReaderT)-import Control.Monad.Trans.State (StateT)-import Network.CAN.Types (CANMessage(..))--class Monad m => MonadCAN m where--  send :: CANMessage -> m ()-  default send-    :: ( MonadTrans t-       , MonadCAN m'-       , m ~ t m'-       )-    => CANMessage-    -> m ()-  send = lift . send--  recv :: m CANMessage-  default recv-    :: ( MonadTrans t-       , MonadCAN m'-       , m ~ t m'-       )-    => m CANMessage-  recv = lift recv--instance MonadCAN m => MonadCAN (ExceptT e m)-instance MonadCAN m => MonadCAN (ReaderT r m)-instance MonadCAN m => MonadCAN (StateT s m)

@@ -8,19 +8,21 @@   -- * Message   , CANMessage(..)   , standardMessage+  , prettyCANMessage   ) where  import Data.Word (Word8, Word16, Word32) import Test.QuickCheck (Arbitrary(..))  import qualified Test.QuickCheck+import qualified Text.Printf  -- * Arbitration  data CANArbitrationField = CANArbitrationField-  { canArbitrationFieldID :: Word32 -- ^ CAN ID-  , canArbitrationFieldExtended :: Bool -- ^ Extended CAN ID-  , canArbitrationFieldRTR :: Bool -- ^ Remote transmission request+  { canArbitrationFieldID       :: Word32 -- ^ CAN ID+  , canArbitrationFieldExtended :: Bool   -- ^ Extended CAN ID+  , canArbitrationFieldRTR      :: Bool   -- ^ Remote transmission request   } deriving (Eq, Ord, Show)  instance Arbitrary CANArbitrationField where@@ -89,3 +91,40 @@   { canMessageArbitrationField = standardID cid   , canMessageData = cdata   }++-- | Pretty print @CANMessage@ similar to candump output+--+-- > prettyCANMessage (standardMessage 123 [0x13, 0x37])+-- "     07B   [2]  13 37"+-- > prettyCANMessage (CANMessage (extendedID 123) [0x13, 0x37])+-- "0000007B   [2]  13 37"+prettyCANMessage+  :: CANMessage+  -> String+prettyCANMessage msg =+  unwords+    $ [ prettyArb+          $ canMessageArbitrationField msg+      , "  [" <> show (length $ canMessageData msg) <> "] "+      ]+      ++ prettyData+           (canArbitrationFieldRTR $ canMessageArbitrationField msg)+           (canMessageData msg)+  where+    prettyArb arb | canArbitrationFieldExtended arb =+      hexFixed+        8+        $ canArbitrationFieldID arb+    prettyArb arb | otherwise =+         replicate 5 ' '+      <> hexFixed+          3+          (canArbitrationFieldID arb)++    prettyData :: Bool -> [Word8] -> [String]+    prettyData True _ = pure "remote request"+    prettyData _    x = map (hexFixed 2) x++    hexFixed width =+      Text.Printf.printf+        $ "%0" <> show (width :: Int) <> "X"

@@ -1,193 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE RecordWildCards #-}-module Network.SLCAN-  ( Transport(..)-  , withSLCANTransport-  , sendSLCANMessage-  , sendSLCANControl-  , recvSLCANMessage-  , sendCANMessage-  , module Network.SLCAN.Types-  , SLCANT(..)-  , SLCANException(..)-  , runSLCAN-  ) where--import Control.Exception (Exception)-import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Reader (MonadReader, ask)-import Control.Monad.Trans (MonadTrans(..))-import Control.Monad.Trans.Reader (ReaderT(..))--import Network.Socket (Socket, SockAddr)-import Network.CAN (CANMessage, MonadCAN(..))-import Network.SLCAN.Types-import System.IO (Handle)-import UnliftIO (MonadUnliftIO)--import qualified Control.Monad-import qualified Control.Exception-import qualified Data.ByteString-import qualified Data.ByteString.Char8-import qualified System.IO-import qualified Network.SLCAN.Builder-import qualified Network.SLCAN.Parser-import qualified Network.Socket.ByteString-import qualified UnliftIO--data Transport =-    Transport_Handle Handle-  | Transport_UDP Socket SockAddr--withSLCANTransport-  :: Transport-  -> SLCANConfig-  -> (Transport -> IO a)-  -> IO a-withSLCANTransport transport SLCANConfig{..} act = do-  let sendC = sendSLCANControl transport-  Control.Exception.finally-    (do-       sendC SLCANControl_Close-       sendC (SLCANControl_Bitrate slCANConfigBitrate)-       Control.Monad.when-         slCANConfigResetErrors-         (sendC SLCANControl_ResetErrors)-       sendC-         (if slCANConfigListenOnly-          then SLCANControl_ListenOnly-          else SLCANControl_Open-         )--       act transport-    )-    (sendC SLCANControl_Close)--sendSLCANMessage-  :: Transport-  -> SLCANMessage-  -> IO ()-sendSLCANMessage (Transport_Handle handle) msg = do-  Control.Monad.void-    $ Data.ByteString.hPutStr-        handle-        $ Network.SLCAN.Builder.buildSLCANMessage-            msg-  System.IO.hFlush handle-sendSLCANMessage (Transport_UDP socket target) msg = do-  Network.Socket.ByteString.sendAllTo-    socket-    (Network.SLCAN.Builder.buildSLCANMessage msg)-    target--sendSLCANControl-  :: Transport-  -> SLCANControl-  -> IO ()-sendSLCANControl t =-  sendSLCANMessage t-  . SLCANMessage_Control--recvSLCANMessage-  :: Transport-  -> IO (Either String SLCANMessage)-recvSLCANMessage (Transport_Handle handle) = do-  Network.SLCAN.Parser.parseSLCANMessage-  <$> hGetTillCR handle--  where-    hGetTillCR h = do-      msg <--        Data.ByteString.hGetSome-          h-          1024-      if Data.ByteString.Char8.last msg == '\r'-      then pure msg-      else hGetTillCR h >>= pure . (msg <>)--recvSLCANMessage (Transport_UDP socket _target) = do-  Network.SLCAN.Parser.parseSLCANMessage-  <$> sockGetTillCR socket-  where-    sockGetTillCR s = do-      (msg, _source) <--        Network.Socket.ByteString.recvFrom-          s-          1024-      if Data.ByteString.Char8.last msg == '\r'-      then pure msg-      else sockGetTillCR s >>= pure . (msg <>)--sendCANMessage-  :: Transport-  -> CANMessage-  -> IO ()-sendCANMessage t =-  sendSLCANMessage t-  . SLCANMessage_Data--newtype SLCANT m a = SLCANT-  { _unSLCANT :: ReaderT Transport m a }-  deriving-    ( Functor-    , Applicative-    , Monad-    , MonadReader Transport-    , MonadIO-    , MonadUnliftIO-    )--instance MonadTrans SLCANT where-  lift = SLCANT . lift---- | Run SLCANT transformer-runSLCANT-  :: Monad m-  => Transport-  -> SLCANT m a-  -> m a-runSLCANT t =-    (`runReaderT` t)-  . _unSLCANT--data SLCANException = SLCANException_ParseError String-    deriving Show--instance Exception SLCANException--runSLCAN-  :: ( MonadIO m-     , MonadUnliftIO m-     )-  => Transport-  -> SLCANConfig-  -> SLCANT m a-  -> m a-runSLCAN transport config act = do-  UnliftIO.withRunInIO $ \runInIO ->-    withSLCANTransport-      transport-      config-      (\t -> runInIO (runSLCANT t act))--instance MonadIO m => MonadCAN (SLCANT m) where-  send cm = do-    ask >>= liftIO . flip sendCANMessage cm-  recv = do-    transport <- ask-    liftIO-      (recvSLCANMessage transport)-    >>= \case-      Left e ->-        UnliftIO.throwIO $ SLCANException_ParseError e-      Right (SLCANMessage_Data cm) ->-        pure cm-      Right _other ->-        -- TODO: do something with-        -- SLCANMessage_Error-        -- and SLCANMessage_State-        -- like allow registering handlers for these-        -- or throwIO on _Error one-        recv

@@ -1,146 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE RecordWildCards #-}--module Network.SLCAN.Builder-  ( buildSLCANMessage-  ) where--import Data.ByteString (ByteString)-import Data.ByteString.Builder (Builder)-import Data.Set (Set)-import Network.CAN.Types (CANArbitrationField(..), CANMessage(..))-import Network.SLCAN.Types-  ( SLCANMessage(..)-  , SLCANControl(..)-  , SLCANState(..)-  , SLCANCounters(..)-  , SLCANError(..)-  )-import qualified Data.Bits-import qualified Data.Set-import qualified Data.ByteString.Lazy-import qualified Data.ByteString.Builder--slCANBuilder-  :: SLCANMessage-  -> Builder-slCANBuilder slcanMsg =-  case slcanMsg of-    SLCANMessage_Control ctrlMsg -> slCANControlBuilder ctrlMsg-    SLCANMessage_Data canMsg -> slCANDataBuilder canMsg-    SLCANMessage_State state counters  -> slCANStateBuilder state counters-    SLCANMessage_Error errs -> slCANErrorBuilder errs-  <> Data.ByteString.Builder.char7 '\r'--slCANControlBuilder-  :: SLCANControl-  -> Builder-slCANControlBuilder SLCANControl_Open =-  Data.ByteString.Builder.char7 'O'-slCANControlBuilder SLCANControl_Close =-  Data.ByteString.Builder.char7 'C'-slCANControlBuilder (SLCANControl_Bitrate bitrate) =-     Data.ByteString.Builder.char7 'S'-  <> Data.ByteString.Builder.intDec-      (fromEnum bitrate)-slCANControlBuilder SLCANControl_ResetErrors =-  Data.ByteString.Builder.char7 'F'-slCANControlBuilder SLCANControl_ListenOnly =-  Data.ByteString.Builder.char7 'L'--slCANDataBuilder-  :: CANMessage-  -> Builder-slCANDataBuilder CANMessage{..} =-     arbitrationId canMessageArbitrationField-  <> Data.ByteString.Builder.word8Hex-      (fromIntegral $ length canMessageData)-  <> mconcat-      (map-         Data.ByteString.Builder.word8HexFixed-         canMessageData-      )--arbitrationId-  :: CANArbitrationField-  -> Builder-arbitrationId CANArbitrationField{..} =-     Data.ByteString.Builder.char7-       (case ( canArbitrationFieldExtended-             , canArbitrationFieldRTR-             )-        of-         (False, False) -> 't'-         (False, True)  -> 'r'-         (True, False)  -> 'T'-         (True, True)   -> 'R'-       )-  <> (if canArbitrationFieldExtended-      then Data.ByteString.Builder.word32HexFixed-      else-        (\word11 ->-           Data.ByteString.Builder.word8Hex-            (fromIntegral (word11 `Data.Bits.shiftR` 8))-        <> Data.ByteString.Builder.word8HexFixed-            (fromIntegral word11)-        )-     )-     canArbitrationFieldID--slCANStateBuilder-  :: SLCANState-  -> SLCANCounters-  -> Builder-slCANStateBuilder state SLCANCounters{..} =-     Data.ByteString.Builder.char7 's'-  <> Data.ByteString.Builder.char7-      (case state of-         SLCANState_Active -> 'a'-         SLCANState_Warning -> 'w'-         SLCANState_Passive -> 'p'-         SLCANState_BusOff -> 'b'-      )-  <> word16Dec3 slCANCountersTxErrors-  <> word16Dec3 slCANCountersRxErrors-  where-    -- encode as 3 bytes (maximum of 999 and zero padded)-    word16Dec3 x =-           (case x of-              _ | x < 10 -> Data.ByteString.Builder.string7 "00"-              _ | x < 100 -> Data.ByteString.Builder.char7 '0'-              _ | otherwise -> mempty-           )-        <> Data.ByteString.Builder.word16Dec-            (min 999 x)--slCANErrorBuilder-  :: Set SLCANError-  -> Builder-slCANErrorBuilder errs =-     Data.ByteString.Builder.char7 'e'-  <> Data.ByteString.Builder.word8Hex-      (fromIntegral $ Data.Set.size errs)-  <> mconcat-      (map-         ( Data.ByteString.Builder.char7-         . \case-             SLCANError_Ack -> 'a'-             SLCANError_Bit0 -> 'b'-             SLCANError_Bit1 -> 'B'-             SLCANError_CRC -> 'c'-             SLCANError_Form -> 'f'-             SLCANError_RxOverrun -> 'o'-             SLCANError_TxOverrun -> 'O'-             SLCANError_Stuff -> 's'-         )-         $ Data.Set.toList-             errs-      )--buildSLCANMessage-  :: SLCANMessage-  -> ByteString-buildSLCANMessage =-   Data.ByteString.Lazy.toStrict- . Data.ByteString.Builder.toLazyByteString- . slCANBuilder

@@ -1,179 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE RecordWildCards #-}--module Network.SLCAN.Parser-  ( parseSLCANMessage-  ) where--import Data.Attoparsec.ByteString.Char8 (Parser)-import Data.Bits (Bits)-import Data.ByteString (ByteString)-import Data.Set (Set)-import Control.Applicative ((<|>))-import Network.CAN.Types (CANArbitrationField(..), CANMessage(..))-import Network.SLCAN.Types-  ( SLCANMessage(..)-  , SLCANControl(..)-  , SLCANBitrate-  , SLCANState(..)-  , SLCANCounters(..)-  , SLCANError(..)-  )--import qualified Data.Attoparsec.ByteString.Char8-import qualified Data.Set-import qualified Control.Monad--slCANParser :: Parser SLCANMessage-slCANParser = do-  Data.Attoparsec.ByteString.Char8.peekChar'-    >>= \case-      c | Data.Attoparsec.ByteString.Char8.inClass "OCSFL" c ->-        (SLCANMessage_Control <$> slCANControlParser)-      c | Data.Attoparsec.ByteString.Char8.inClass "tTrR" c ->-        (SLCANMessage_Data <$> slCANDataParser)-      's' ->-        Data.Attoparsec.ByteString.Char8.char 's'-        *> (SLCANMessage_State <$> slCANStateParser <*> slCANCountersParser)-      'e' ->-        Data.Attoparsec.ByteString.Char8.char 'e'-        *> (SLCANMessage_Error <$> slCANErrorParser)-      c | otherwise ->-        fail $ "Unknown SLCAN message type: " <> show c-  <* Data.Attoparsec.ByteString.Char8.char '\r'--slCANControlParser :: Parser SLCANControl-slCANControlParser = do-  Data.Attoparsec.ByteString.Char8.anyChar-  >>= \case-    'O' -> pure SLCANControl_Open-    'C' -> pure SLCANControl_Close-    'S' -> (SLCANControl_Bitrate <$> bitrate)-    'F' -> pure SLCANControl_ResetErrors-    'L' -> pure SLCANControl_ListenOnly-    c   -> fail $ "Unknown control message char: " <> show c-  where-    bitrate = do-      d <- Data.Attoparsec.ByteString.Char8.decimal-      if d > fromEnum (maxBound :: SLCANBitrate)-      then fail-             $ "Bitrate out of bounds, got "-             <> show d-             <> "but maximum is "-             <> show (fromEnum (maxBound :: SLCANBitrate))-             <> " ("-             <> show  (maxBound :: SLCANBitrate)-             <> ")"-      else pure $ toEnum d--slCANDataParser :: Parser CANMessage-slCANDataParser = do-  canMessageArbitrationField <- arbitrationId-  msgLen <- hexadecimalWithLength 1-  canMessageData <--    Control.Monad.replicateM msgLen (hexadecimalWithLength 2)-  pure CANMessage{..}---- | Parse arbitration ID--- * t => 11 bit data frame--- * r => 11 bit RTR frame--- * T => 29 bit data frame--- * R => 29 bit RTR frame-arbitrationId :: Parser CANArbitrationField-arbitrationId = do-      Data.Attoparsec.ByteString.Char8.char 't' *> stdID False-  <|> Data.Attoparsec.ByteString.Char8.char 'r' *> stdID True-  <|> Data.Attoparsec.ByteString.Char8.char 'T' *> extID False-  <|> Data.Attoparsec.ByteString.Char8.char 'R' *> extID True--stdID-  :: Bool-  -> Parser CANArbitrationField-stdID isRTR = do-  canArbitrationFieldID-    <- hexadecimalWithLength 3--  let-    canArbitrationFieldExtended = False-    canArbitrationFieldRTR = isRTR--  pure CANArbitrationField{..}--extID-  :: Bool-  -> Parser CANArbitrationField-extID isRTR = do-  canArbitrationFieldID-    <- hexadecimalWithLength 8--  let-    canArbitrationFieldExtended = True-    canArbitrationFieldRTR = isRTR--  pure CANArbitrationField{..}--hexadecimalWithLength-  :: ( Bits a-     , Integral a-     )-  => Int-  -> Parser a-hexadecimalWithLength len =-  Data.Attoparsec.ByteString.Char8.take len-  >>=-  either-    fail-    pure-    . Data.Attoparsec.ByteString.Char8.parseOnly-        Data.Attoparsec.ByteString.Char8.hexadecimal--slCANStateParser :: Parser SLCANState-slCANStateParser =-  Data.Attoparsec.ByteString.Char8.anyChar-  >>= \case-    'a' -> pure SLCANState_Active-    'w' -> pure SLCANState_Warning-    'p' -> pure SLCANState_Passive-    'b' -> pure SLCANState_BusOff-    c   -> fail $ "Unknown state char: " <> show c--slCANCountersParser :: Parser SLCANCounters-slCANCountersParser = do-    slCANCountersTxErrors <- decimal3-    slCANCountersRxErrors <- decimal3-    pure $ SLCANCounters{..}-  where-    decimal3 =-      Data.Attoparsec.ByteString.Char8.take 3-      >>=-      either-        fail-        pure-        . Data.Attoparsec.ByteString.Char8.parseOnly-            Data.Attoparsec.ByteString.Char8.decimal--slCANErrorParser :: Parser (Set SLCANError)-slCANErrorParser = do-  len <- hexadecimalWithLength 1-  Data.Set.fromList-    <$> Control.Monad.replicateM len errorChar-  where-    errorChar =-      Data.Attoparsec.ByteString.Char8.anyChar-      >>= \case-        'a' -> pure SLCANError_Ack-        'b' -> pure SLCANError_Bit0-        'B' -> pure SLCANError_Bit1-        'c' -> pure SLCANError_CRC-        'f' -> pure SLCANError_Form-        'o' -> pure SLCANError_RxOverrun-        'O' -> pure SLCANError_TxOverrun-        's' -> pure SLCANError_Stuff-        c   -> fail $ "Unknown error char: " <> show c--parseSLCANMessage-  :: ByteString-  -> Either String SLCANMessage-parseSLCANMessage =-  Data.Attoparsec.ByteString.Char8.parseOnly-    slCANParser

@@ -1,129 +0,0 @@-{-# LANGUAGE NumericUnderscores #-}-module Network.SLCAN.Types-  ( SLCANMessage(..)-  , SLCANControl(..)-  , SLCANBitrate(..)-  , numericBitrate-  , SLCANState(..)-  , SLCANCounters(..)-  , SLCANError(..)-  , SLCANConfig(..)-  ) where--import Data.Default.Class (Default(def))-import Data.Set (Set)-import Data.Word (Word16)-import Network.CAN.Types (CANMessage)-import Test.QuickCheck (Arbitrary(..))--import qualified Test.QuickCheck--data SLCANMessage-  = SLCANMessage_Control SLCANControl-  | SLCANMessage_Data CANMessage-  | SLCANMessage_State SLCANState SLCANCounters-  | SLCANMessage_Error (Set SLCANError)-  deriving (Eq, Ord, Show)--instance Arbitrary SLCANMessage where-  arbitrary = Test.QuickCheck.oneof-    [ SLCANMessage_Control <$> arbitrary-    , SLCANMessage_Data <$> arbitrary-    , SLCANMessage_State <$> arbitrary <*> arbitrary-    , SLCANMessage_Error <$> arbitrary-    ]--data SLCANControl-  = SLCANControl_Open-  | SLCANControl_Close-  | SLCANControl_Bitrate SLCANBitrate-  | SLCANControl_ResetErrors-  | SLCANControl_ListenOnly-  deriving (Eq, Ord, Show)--instance Arbitrary SLCANControl where-  arbitrary = Test.QuickCheck.oneof-    [ pure SLCANControl_Open-    , pure SLCANControl_Close-    , SLCANControl_Bitrate <$> arbitrary-    , pure SLCANControl_ResetErrors-    , pure SLCANControl_ListenOnly-    ]--data SLCANBitrate-  = SLCANBitrate_10K-  | SLCANBitrate_20K-  | SLCANBitrate_50K-  | SLCANBitrate_100K-  | SLCANBitrate_125K-  | SLCANBitrate_250K-  | SLCANBitrate_500K-  | SLCANBitrate_800K-  | SLCANBitrate_1M-  deriving (Bounded, Eq, Enum, Ord, Show)--instance Arbitrary SLCANBitrate where-  arbitrary = Test.QuickCheck.arbitraryBoundedEnum--instance Default SLCANBitrate where-  def = SLCANBitrate_1M--numericBitrate :: SLCANBitrate -> Int-numericBitrate SLCANBitrate_10K  =    10_000-numericBitrate SLCANBitrate_20K  =    20_000-numericBitrate SLCANBitrate_50K  =    50_000-numericBitrate SLCANBitrate_100K =   100_000-numericBitrate SLCANBitrate_125K =   125_000-numericBitrate SLCANBitrate_250K =   250_000-numericBitrate SLCANBitrate_500K =   500_000-numericBitrate SLCANBitrate_800K =   800_000-numericBitrate SLCANBitrate_1M   = 1_000_000--data SLCANState-  = SLCANState_Active-  | SLCANState_Warning-  | SLCANState_Passive-  | SLCANState_BusOff-  deriving (Bounded, Eq, Enum, Ord, Show)--instance Arbitrary SLCANState where-  arbitrary = Test.QuickCheck.arbitraryBoundedEnum--data SLCANCounters = SLCANCounters-  { slCANCountersRxErrors :: Word16-  , slCANCountersTxErrors :: Word16-  } deriving (Eq, Ord, Show)--instance Arbitrary SLCANCounters where-  arbitrary =-    SLCANCounters-      <$> Test.QuickCheck.choose (0, 999)-      <*> Test.QuickCheck.choose (0, 999)--data SLCANError-  = SLCANError_Ack-  | SLCANError_Bit0-  | SLCANError_Bit1-  | SLCANError_CRC-  | SLCANError_Form-  | SLCANError_RxOverrun-  | SLCANError_TxOverrun-  | SLCANError_Stuff-  deriving (Bounded, Eq, Enum, Ord, Show)--instance Arbitrary SLCANError where-  arbitrary = Test.QuickCheck.arbitraryBoundedEnum--data SLCANConfig = SLCANConfig-  { slCANConfigBitrate :: SLCANBitrate-  , slCANConfigResetErrors :: Bool-  , slCANConfigListenOnly :: Bool-  } deriving (Eq, Ord, Show)--instance Default SLCANConfig where-  def =-    SLCANConfig-    { slCANConfigBitrate = def-    , slCANConfigResetErrors = False-    , slCANConfigListenOnly = False-    }

@@ -1,122 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Network.SocketCAN-  ( withSocketCAN-  , sendCANMessage-  , recvCANMessage-  , Network.Socket.ifNameToIndex-  , SocketCANT-  , CANInterface-  , mkCANInterface-  , NoSuchInterface(..)-  , runSocketCAN-  ) where--import Network.CAN (CANMessage, MonadCAN(..))-import Network.Socket (Socket)-import Network.SocketCAN.Bindings (SockAddrCAN(..))--import Control.Monad.Reader (MonadReader, ask)-import Control.Monad.Trans (MonadTrans(..))-import Control.Monad.Trans.Reader (ReaderT(..))-import UnliftIO--import qualified Control.Exception-import qualified Network.Socket (ifNameToIndex)-import qualified Network.SocketCAN.LowLevel-import qualified Network.SocketCAN.Translate--withSocketCAN-  :: Int-  -> (Socket -> IO a)-  -> IO a-withSocketCAN ifaceIdx act = do-  Control.Exception.bracket-    Network.SocketCAN.LowLevel.socket-    Network.SocketCAN.LowLevel.close-    (\canSock -> do-      Network.SocketCAN.LowLevel.bind-        canSock-        $ Network.SocketCAN.Bindings.SockAddrCAN-          $ fromIntegral ifaceIdx-      act canSock-    )--sendCANMessage-  :: Socket-  -> CANMessage-  -> IO ()-sendCANMessage canSock cm =-  Network.SocketCAN.LowLevel.send-    canSock-    (Network.SocketCAN.Translate.toSocketCANFrame cm)--recvCANMessage-  :: Socket-  -> IO CANMessage-recvCANMessage canSock =-  Network.SocketCAN.LowLevel.recv canSock-  >>= pure . Network.SocketCAN.Translate.fromSocketCANFrame--newtype SocketCANT m a = SocketCANT-  { _unSocketCANT :: ReaderT Socket m a }-  deriving-    ( Functor-    , Applicative-    , Monad-    , MonadReader Socket-    , MonadIO-    , MonadUnliftIO-    )--instance MonadTrans SocketCANT where-  lift = SocketCANT . lift---- | Run SocketCANT transformer-runSocketCANT-  :: Monad m-  => Socket-  -> SocketCANT m a-  -> m a-runSocketCANT sock =-    (`runReaderT` sock)-  . _unSocketCANT--newtype CANInterface = CANInterface-  { unCANInterface :: String }-  deriving Eq--instance Show CANInterface where-  show = unCANInterface--mkCANInterface :: String -> CANInterface-mkCANInterface = CANInterface--data NoSuchInterface = NoSuchInterface-    deriving Show--instance Exception NoSuchInterface--runSocketCAN-  :: ( MonadIO m-     , MonadUnliftIO m-     )-  => CANInterface-  -> SocketCANT m a-  -> m a-runSocketCAN interface act = do-  mIdx <--    liftIO-    $ Network.Socket.ifNameToIndex (unCANInterface interface)--  case mIdx of-    Nothing -> throwIO NoSuchInterface-    Just idx -> withRunInIO $ \runInIO ->-      withSocketCAN idx (\s -> runInIO (runSocketCANT s act))--instance MonadIO m => MonadCAN (SocketCANT m) where-  send cm = do-    canSock <- ask-    liftIO $ sendCANMessage canSock cm-  recv = do-    canSock <- ask-    liftIO $ recvCANMessage canSock

@@ -1,79 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Network.SocketCAN.Bindings-  (-  -- * Network package compatibility-    SockAddrCAN(..)-  , pattern CAN_RAW-  -- * SocketCAN bindings-  , SocketCANArbitrationField(..)-  , SocketCANFrame(..)-  ) where--import Data.Word (Word8, Word16, Word32)-import Foreign.Storable (Storable(..))-import Foreign.Marshal.Array (peekArray, pokeArray)-import Foreign.Ptr (plusPtr)-import Network.Socket.Address (SocketAddress(..))-import Network.Socket (ProtocolNumber)--#include <linux/can.h>-#include <sys/socket.h>---- | CAN Socket type-newtype SockAddrCAN = SockAddrCAN Word32-  deriving (Eq, Ord)---- Word16-type CSaFamily = (#type sa_family_t)--instance SocketAddress SockAddrCAN where-  sizeOfSocketAddress (SockAddrCAN _) =-    #const sizeof(struct sockaddr_can)-  peekSocketAddress sap = do-    ifidx <- (#peek struct sockaddr_can, can_ifindex) sap-    return (SockAddrCAN ifidx)-  pokeSocketAddress p (SockAddrCAN ifIndex) = do-    (#poke struct sockaddr_can, can_family) p ((#const AF_CAN) :: CSaFamily)-    (#poke struct sockaddr_can, can_ifindex) p ifIndex---- | CAN RAW protocol family of PF_CAN-pattern CAN_RAW :: ProtocolNumber-pattern CAN_RAW = #const CAN_RAW---- | SocketCAN Arbitration field (CAN ID including RTR, EFF, ERR bits)-newtype SocketCANArbitrationField =-  SocketCANArbitrationField { unSocketCANArbitrationField :: Word32 }-  deriving (Eq, Ord, Show, Storable)--data SocketCANFrame = SocketCANFrame-  { socketCANFrameArbitrationField :: SocketCANArbitrationField-  , socketCANFrameLength :: Word8-  , socketCANFrameData   :: [Word8]-  } deriving Show--instance Storable SocketCANFrame where-  sizeOf ~_ = #const sizeof(struct can_frame)-  alignment ~_ = #alignment struct can_frame-  peek ptr = do-    socketCANFrameArbitrationField-      <- #{peek struct can_frame, can_id} ptr-    socketCANFrameLength-      <- #{peek struct can_frame, len} ptr-    socketCANFrameData <--      peekArray-        (fromIntegral socketCANFrameLength)-        (#{ptr struct can_frame, data} ptr)-    pure-      $ SocketCANFrame{..}-  poke ptr SocketCANFrame{..} = do-    #{poke struct can_frame, can_id}-      ptr-      socketCANFrameArbitrationField-    #{poke struct can_frame, len}-      ptr-      socketCANFrameLength-    pokeArray-      (#{ptr struct can_frame, data} ptr)-      socketCANFrameData

@@ -1,41 +0,0 @@-module Network.SocketCAN.Example where--import Control.Monad (forever)-import Network.CAN-import Network.Socket (Socket)-import Network.SocketCAN--import qualified Network.Socket--example :: IO ()-example = do-  let interface = "vcan0"-  mIdx <- Network.Socket.ifNameToIndex interface-  case mIdx of-    Nothing -> error $ "Interface " <> interface <> " not found"-    Just idx ->-      withSocketCAN idx act--act :: Socket -> IO ()-act sock = do-  sendCANMessage-    sock-    $ standardMessage-        0x123-        [0xDE, 0xAD]--  sendCANMessage-    sock-    $ CANMessage-        (extendedID 0x123456)-        [0xEE]--  sendCANMessage-    sock-    $ CANMessage-        (setRTR $ extendedID 0x123)-        [0xDE, 0xAD, 0x11]--  forever-    $ recvCANMessage sock-    >>= print

@@ -1,62 +0,0 @@-{-# LANGUAGE TypeApplications #-}-module Network.SocketCAN.LowLevel-  ( socket-  , bind-  , send-  , recv-  , module Network.Socket-  ) where--import Control.Monad (void)-import Foreign.Ptr (Ptr)-import Network.Socket (Family(AF_CAN), Socket, close)-import Network.SocketCAN.Bindings (SockAddrCAN(..), SocketCANFrame)--import qualified Foreign.Ptr-import qualified Foreign.Marshal.Alloc-import qualified Foreign.Storable-import qualified Network.Socket-import qualified Network.Socket.Address-import qualified Network.SocketCAN.Bindings---- | Create raw CAN socket-socket-  :: IO Socket-socket =-  Network.Socket.socket-    AF_CAN-    Network.Socket.Raw-    Network.SocketCAN.Bindings.CAN_RAW---- | Bind CAN socket-bind-  :: Socket-  -> SockAddrCAN-  -> IO ()-bind = Network.Socket.Address.bind--send-  :: Socket-  -> SocketCANFrame-  -> IO ()-send canSock cf =-  Foreign.Marshal.Alloc.alloca $ \ptr -> do-    Foreign.Storable.poke ptr cf-    void-      $ Network.Socket.sendBuf-          canSock-          (Foreign.Ptr.castPtr ptr)-          (Foreign.Storable.sizeOf cf)--recv-  :: Socket-  -> IO SocketCANFrame-recv canSock =-  Foreign.Marshal.Alloc.alloca $ \ptr -> do-    (_nBytes, _sockAddr) <--      Network.Socket.Address.recvBufFrom-        @SockAddrCAN-        canSock-        (ptr :: Ptr SocketCANFrame)-        (Foreign.Storable.sizeOf (undefined :: SocketCANFrame))-    Foreign.Storable.peek ptr >>= pure

@@ -1,77 +0,0 @@-{-# LANGUAGE RecordWildCards #-}---- | Translation between CANMessage and SocketCANFrame--module Network.SocketCAN.Translate-  ( toSocketCANFrame-  , fromSocketCANFrame-  ) where--import Data.Bits ((.&.), (.|.), shiftL)-import Data.Word (Word32)-import Network.CAN.Types (CANArbitrationField(..), CANMessage(..))-import Network.SocketCAN.Bindings (SocketCANArbitrationField(..), SocketCANFrame(..))-import qualified Data.Bool--toSocketCANFrame-  :: CANMessage-  -> SocketCANFrame-toSocketCANFrame CANMessage{..} =-  SocketCANFrame-  { socketCANFrameArbitrationField =-      toSocketCANArbitrationField-        canMessageArbitrationField-  , socketCANFrameLength =-      fromIntegral $ length canMessageData-  , socketCANFrameData = canMessageData-  }--fromSocketCANFrame-  :: SocketCANFrame-  -> CANMessage-fromSocketCANFrame SocketCANFrame{..} =-  CANMessage-  { canMessageArbitrationField =-      fromSocketCANArbitrationField-        socketCANFrameArbitrationField-  , canMessageData = socketCANFrameData-  }--toSocketCANArbitrationField-  :: CANArbitrationField-  -> SocketCANArbitrationField-toSocketCANArbitrationField CANArbitrationField{..} =-  SocketCANArbitrationField-  $ Data.Bool.bool-      id-      (.|. effBit)-      canArbitrationFieldExtended-  $ Data.Bool.bool-      id-      (.|. rtrBit)-      canArbitrationFieldRTR-  $ canArbitrationFieldID--fromSocketCANArbitrationField-  :: SocketCANArbitrationField-  -> CANArbitrationField-fromSocketCANArbitrationField (SocketCANArbitrationField scid) =-  let-    isEff = scid .&. effBit /= 0-  in-    CANArbitrationField-    { canArbitrationFieldID =-        Data.Bool.bool-          (.&. (1 `shiftL` 12 - 1))-          (.&. (1 `shiftL` 30 - 1))-          isEff-        $ scid-    , canArbitrationFieldExtended = isEff-    , canArbitrationFieldRTR = scid .&. rtrBit /= 0-    }--effBit :: Word32-effBit = 1 `shiftL` 31--rtrBit :: Word32-rtrBit = 1 `shiftL` 30

@@ -0,0 +1,21 @@+module CANSpec where++import Test.Hspec (Spec, describe, it, shouldBe)+import Samples++import qualified Network.CAN++spec :: Spec+spec = do+  describe "CAN" $ do+    it "pretty prints samples" $+      map Network.CAN.prettyCANMessage samples+      `shouldBe`+      [ "     000   [0] "+      , "     FFF   [0] "+      , "     123   [2]  DE AD"+      , "     123   [0]  remote request"+      , "00000000   [0] "+      , "00123456   [1]  EE"+      , "00123456   [0]  remote request"+      ]