{-# 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 :: forall a. Int -> (Socket -> IO a) -> IO a
withSocketCAN Int
ifaceIdx Socket -> IO a
act = do
  IO Socket -> (Socket -> IO ()) -> (Socket -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Control.Exception.bracket
    IO Socket
Network.SocketCAN.LowLevel.socket
    Socket -> IO ()
Network.SocketCAN.LowLevel.close
    (\Socket
canSock -> do
      Socket -> SockAddrCAN -> IO ()
Network.SocketCAN.LowLevel.bind
        Socket
canSock
        (SockAddrCAN -> IO ()) -> SockAddrCAN -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32 -> SockAddrCAN
Network.SocketCAN.Bindings.SockAddrCAN
          (Word32 -> SockAddrCAN) -> Word32 -> SockAddrCAN
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ifaceIdx
      Socket -> IO a
act Socket
canSock
    )

sendCANMessage
  :: Socket
  -> CANMessage
  -> IO ()
sendCANMessage :: Socket -> CANMessage -> IO ()
sendCANMessage Socket
canSock CANMessage
cm =
  Socket -> SocketCANFrame -> IO ()
Network.SocketCAN.LowLevel.send
    Socket
canSock
    (CANMessage -> SocketCANFrame
Network.SocketCAN.Translate.toSocketCANFrame CANMessage
cm)

recvCANMessage
  :: Socket
  -> IO CANMessage
recvCANMessage :: Socket -> IO CANMessage
recvCANMessage Socket
canSock =
  Socket -> IO SocketCANFrame
Network.SocketCAN.LowLevel.recv Socket
canSock
  IO SocketCANFrame
-> (SocketCANFrame -> IO CANMessage) -> IO CANMessage
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CANMessage -> IO CANMessage
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CANMessage -> IO CANMessage)
-> (SocketCANFrame -> CANMessage)
-> SocketCANFrame
-> IO CANMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketCANFrame -> CANMessage
Network.SocketCAN.Translate.fromSocketCANFrame

newtype SocketCANT m a = SocketCANT
  { forall (m :: * -> *) a. SocketCANT m a -> ReaderT Socket m a
_unSocketCANT :: ReaderT Socket m a }
  deriving
    ( (forall a b. (a -> b) -> SocketCANT m a -> SocketCANT m b)
-> (forall a b. a -> SocketCANT m b -> SocketCANT m a)
-> Functor (SocketCANT m)
forall a b. a -> SocketCANT m b -> SocketCANT m a
forall a b. (a -> b) -> SocketCANT m a -> SocketCANT m b
forall (m :: * -> *) a b.
Functor m =>
a -> SocketCANT m b -> SocketCANT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SocketCANT m a -> SocketCANT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SocketCANT m a -> SocketCANT m b
fmap :: forall a b. (a -> b) -> SocketCANT m a -> SocketCANT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> SocketCANT m b -> SocketCANT m a
<$ :: forall a b. a -> SocketCANT m b -> SocketCANT m a
Functor
    , Functor (SocketCANT m)
Functor (SocketCANT m) =>
(forall a. a -> SocketCANT m a)
-> (forall a b.
    SocketCANT m (a -> b) -> SocketCANT m a -> SocketCANT m b)
-> (forall a b c.
    (a -> b -> c)
    -> SocketCANT m a -> SocketCANT m b -> SocketCANT m c)
-> (forall a b. SocketCANT m a -> SocketCANT m b -> SocketCANT m b)
-> (forall a b. SocketCANT m a -> SocketCANT m b -> SocketCANT m a)
-> Applicative (SocketCANT m)
forall a. a -> SocketCANT m a
forall a b. SocketCANT m a -> SocketCANT m b -> SocketCANT m a
forall a b. SocketCANT m a -> SocketCANT m b -> SocketCANT m b
forall a b.
SocketCANT m (a -> b) -> SocketCANT m a -> SocketCANT m b
forall a b c.
(a -> b -> c) -> SocketCANT m a -> SocketCANT m b -> SocketCANT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (SocketCANT m)
forall (m :: * -> *) a. Applicative m => a -> SocketCANT m a
forall (m :: * -> *) a b.
Applicative m =>
SocketCANT m a -> SocketCANT m b -> SocketCANT m a
forall (m :: * -> *) a b.
Applicative m =>
SocketCANT m a -> SocketCANT m b -> SocketCANT m b
forall (m :: * -> *) a b.
Applicative m =>
SocketCANT m (a -> b) -> SocketCANT m a -> SocketCANT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SocketCANT m a -> SocketCANT m b -> SocketCANT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> SocketCANT m a
pure :: forall a. a -> SocketCANT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
SocketCANT m (a -> b) -> SocketCANT m a -> SocketCANT m b
<*> :: forall a b.
SocketCANT m (a -> b) -> SocketCANT m a -> SocketCANT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SocketCANT m a -> SocketCANT m b -> SocketCANT m c
liftA2 :: forall a b c.
(a -> b -> c) -> SocketCANT m a -> SocketCANT m b -> SocketCANT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
SocketCANT m a -> SocketCANT m b -> SocketCANT m b
*> :: forall a b. SocketCANT m a -> SocketCANT m b -> SocketCANT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
SocketCANT m a -> SocketCANT m b -> SocketCANT m a
<* :: forall a b. SocketCANT m a -> SocketCANT m b -> SocketCANT m a
Applicative
    , Applicative (SocketCANT m)
Applicative (SocketCANT m) =>
(forall a b.
 SocketCANT m a -> (a -> SocketCANT m b) -> SocketCANT m b)
-> (forall a b. SocketCANT m a -> SocketCANT m b -> SocketCANT m b)
-> (forall a. a -> SocketCANT m a)
-> Monad (SocketCANT m)
forall a. a -> SocketCANT m a
forall a b. SocketCANT m a -> SocketCANT m b -> SocketCANT m b
forall a b.
SocketCANT m a -> (a -> SocketCANT m b) -> SocketCANT m b
forall (m :: * -> *). Monad m => Applicative (SocketCANT m)
forall (m :: * -> *) a. Monad m => a -> SocketCANT m a
forall (m :: * -> *) a b.
Monad m =>
SocketCANT m a -> SocketCANT m b -> SocketCANT m b
forall (m :: * -> *) a b.
Monad m =>
SocketCANT m a -> (a -> SocketCANT m b) -> SocketCANT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
SocketCANT m a -> (a -> SocketCANT m b) -> SocketCANT m b
>>= :: forall a b.
SocketCANT m a -> (a -> SocketCANT m b) -> SocketCANT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
SocketCANT m a -> SocketCANT m b -> SocketCANT m b
>> :: forall a b. SocketCANT m a -> SocketCANT m b -> SocketCANT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> SocketCANT m a
return :: forall a. a -> SocketCANT m a
Monad
    , MonadReader Socket
    , Monad (SocketCANT m)
Monad (SocketCANT m) =>
(forall a. IO a -> SocketCANT m a) -> MonadIO (SocketCANT m)
forall a. IO a -> SocketCANT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (SocketCANT m)
forall (m :: * -> *) a. MonadIO m => IO a -> SocketCANT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> SocketCANT m a
liftIO :: forall a. IO a -> SocketCANT m a
MonadIO
    , MonadIO (SocketCANT m)
MonadIO (SocketCANT m) =>
(forall b.
 ((forall a. SocketCANT m a -> IO a) -> IO b) -> SocketCANT m b)
-> MonadUnliftIO (SocketCANT m)
forall b.
((forall a. SocketCANT m a -> IO a) -> IO b) -> SocketCANT m b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
forall (m :: * -> *). MonadUnliftIO m => MonadIO (SocketCANT m)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. SocketCANT m a -> IO a) -> IO b) -> SocketCANT m b
$cwithRunInIO :: forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. SocketCANT m a -> IO a) -> IO b) -> SocketCANT m b
withRunInIO :: forall b.
((forall a. SocketCANT m a -> IO a) -> IO b) -> SocketCANT m b
MonadUnliftIO
    )

instance MonadTrans SocketCANT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> SocketCANT m a
lift = ReaderT Socket m a -> SocketCANT m a
forall (m :: * -> *) a. ReaderT Socket m a -> SocketCANT m a
SocketCANT (ReaderT Socket m a -> SocketCANT m a)
-> (m a -> ReaderT Socket m a) -> m a -> SocketCANT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT Socket m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT Socket m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Run SocketCANT transformer
runSocketCANT
  :: Monad m
  => Socket
  -> SocketCANT m a
  -> m a
runSocketCANT :: forall (m :: * -> *) a. Monad m => Socket -> SocketCANT m a -> m a
runSocketCANT Socket
sock =
    (ReaderT Socket m a -> Socket -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Socket
sock)
  (ReaderT Socket m a -> m a)
-> (SocketCANT m a -> ReaderT Socket m a) -> SocketCANT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketCANT m a -> ReaderT Socket m a
forall (m :: * -> *) a. SocketCANT m a -> ReaderT Socket m a
_unSocketCANT

newtype CANInterface = CANInterface
  { CANInterface -> String
unCANInterface :: String }
  deriving CANInterface -> CANInterface -> Bool
(CANInterface -> CANInterface -> Bool)
-> (CANInterface -> CANInterface -> Bool) -> Eq CANInterface
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CANInterface -> CANInterface -> Bool
== :: CANInterface -> CANInterface -> Bool
$c/= :: CANInterface -> CANInterface -> Bool
/= :: CANInterface -> CANInterface -> Bool
Eq

instance Show CANInterface where
  show :: CANInterface -> String
show = CANInterface -> String
unCANInterface

mkCANInterface :: String -> CANInterface
mkCANInterface :: String -> CANInterface
mkCANInterface = String -> CANInterface
CANInterface

data NoSuchInterface = NoSuchInterface
    deriving Int -> NoSuchInterface -> ShowS
[NoSuchInterface] -> ShowS
NoSuchInterface -> String
(Int -> NoSuchInterface -> ShowS)
-> (NoSuchInterface -> String)
-> ([NoSuchInterface] -> ShowS)
-> Show NoSuchInterface
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoSuchInterface -> ShowS
showsPrec :: Int -> NoSuchInterface -> ShowS
$cshow :: NoSuchInterface -> String
show :: NoSuchInterface -> String
$cshowList :: [NoSuchInterface] -> ShowS
showList :: [NoSuchInterface] -> ShowS
Show

instance Exception NoSuchInterface

runSocketCAN
  :: ( MonadIO m
     , MonadUnliftIO m
     )
  => CANInterface
  -> SocketCANT m a
  -> m a
runSocketCAN :: forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m) =>
CANInterface -> SocketCANT m a -> m a
runSocketCAN CANInterface
interface SocketCANT m a
act = do
  Maybe Int
mIdx <-
    IO (Maybe Int) -> m (Maybe Int)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO (Maybe Int) -> m (Maybe Int))
-> IO (Maybe Int) -> m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe Int)
Network.Socket.ifNameToIndex (CANInterface -> String
unCANInterface CANInterface
interface)

  case Maybe Int
mIdx of
    Maybe Int
Nothing -> NoSuchInterface -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO NoSuchInterface
NoSuchInterface
    Just Int
idx -> ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
      Int -> (Socket -> IO a) -> IO a
forall a. Int -> (Socket -> IO a) -> IO a
withSocketCAN Int
idx (\Socket
s -> m a -> IO a
forall a. m a -> IO a
runInIO (Socket -> SocketCANT m a -> m a
forall (m :: * -> *) a. Monad m => Socket -> SocketCANT m a -> m a
runSocketCANT Socket
s SocketCANT m a
act))

instance MonadIO m => MonadCAN (SocketCANT m) where
  send :: CANMessage -> SocketCANT m ()
send CANMessage
cm = do
    Socket
canSock <- SocketCANT m Socket
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO () -> SocketCANT m ()
forall a. IO a -> SocketCANT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SocketCANT m ()) -> IO () -> SocketCANT m ()
forall a b. (a -> b) -> a -> b
$ Socket -> CANMessage -> IO ()
sendCANMessage Socket
canSock CANMessage
cm
  recv :: SocketCANT m CANMessage
recv = do
    Socket
canSock <- SocketCANT m Socket
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO CANMessage -> SocketCANT m CANMessage
forall a. IO a -> SocketCANT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CANMessage -> SocketCANT m CANMessage)
-> IO CANMessage -> SocketCANT m CANMessage
forall a b. (a -> b) -> a -> b
$ Socket -> IO CANMessage
recvCANMessage Socket
canSock