sport 2.0.0.0 → 3.0.0.0

raw patch · 7 files changed

+73/−145 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +2/−1
• lib/Sport.hs +6/−7
• lib/Sport/Main.hs +8/−7
• lib/Sport/Sport.hs +39/−116
• sport.cabal +1/−1
• test/Main.hs +12/−13

@@ -1,5 +1,10 @@ # Revision history for sport +## 3.0.0.0 -- 6-7-2026++* Update `withSport`, add `withNewSport`+* Remove `runSport` daemon+ ## 2.0.0.0 -- 6-6-2026  * Add `flushSport`, `withOpenSport`

@@ -5,7 +5,8 @@ ```hs import Sport -main = withSport $ \s -> do+main = do+  s <- newSportIO   openSport s defSportCfg{path="/dev/ttyUSB1"}   bs <- readSport s 64   writeSport s bs

@@ -3,24 +3,23 @@ -- @ -- import Sport ----- main = withSport $ \\s -> do+-- main = do+--   s <- newSportIO --   openSport s defSportCfg{path="\/dev\/ttyUSB1", speed=B19200} --   bs <- readSport s 64 --   writeSport s bs -- @ module Sport-  ( -- *** Handle & Daemon+  ( -- *** Handle     Sport-  , withSport-  , withOpenSport+  , withNewSport   , newSportIO   , newSport-  , runSport   , -- *** Open & Close-    openSport+    withSport+  , openSport   , isOpenSport   , getSportCfg-  , getOpenSportCfg   , defSportCfg   , SportCfg(..)   , BufferMode(..)

@@ -7,14 +7,15 @@ import System.IO import System.Posix +-- | Main executable sportMain :: IO ()-sportMain =-  withSport $ \s -> do-    putStrLn "...UNIX.SERIAL.PORT..."-    hSetBuffering stdin  NoBuffering-    hSetBuffering stdout NoBuffering-    openSport s defSportCfg{speed = B19200}-    concurrently_ (reading s) (writing s)+sportMain = do+  s <- newSportIO+  putStrLn "...UNIX.SERIAL.PORT..."+  hSetBuffering stdin  NoBuffering+  hSetBuffering stdout NoBuffering+  openSport s defSportCfg{speed = B19200}+  concurrently_ (reading s) (writing s)  reading :: Sport -> IO a reading s = forever $ putChar . BS.head =<< readSport s 1

@@ -1,15 +1,13 @@ -- | Internal high-level serial port module Sport.Sport   ( Sport+  , withNewSport   , newSportIO   , newSport   , withSport-  , withOpenSport-  , runSport   , openSport   , isOpenSport   , getSportCfg-  , getOpenSportCfg   , defSportCfg   , SportCfg(..)   , closeSport@@ -21,21 +19,21 @@   , displaySportException   ) where -import Control.Concurrent.Async import Control.Concurrent.STM import Control.Exception import Control.Monad import qualified Data.ByteString as Strict import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BS-import Data.Functor-import Data.Maybe import qualified Sport.Serial as S import System.IO import System.Posix  -- | Serial port handle-newtype Sport = Sport (TVar State)+data Sport = Sport+  { cfgVar  :: TMVar SportCfg+  , hndlVar :: TMVar Handle+  }  -- | Acquire IO serial port newSportIO :: IO Sport@@ -43,28 +41,11 @@  -- | Acquire STM serial port newSport :: STM Sport-newSport = Sport <$> newTVar Closed--data State-  = Closed-  | Opening SportCfg (TMVar (Either SomeException ()))-  | Open SportCfg Handle-  deriving Eq--readHandle :: Sport -> STM Handle-readHandle (Sport s) = do-  st <- readTVar s-  case st of-    Closed    -> retry-    Opening{} -> retry-    Open _ h  -> return h--tryReadHandle :: Sport -> STM (Maybe Handle)-tryReadHandle s = Just `fmap` readHandle s `orElse` pure Nothing+newSport = Sport <$> newEmptyTMVar <*> newEmptyTMVar  -- | Check if serial port is open isOpenSport :: Sport -> STM Bool-isOpenSport s = isJust <$> tryReadHandle s+isOpenSport = fmap not . isEmptyTMVar . cfgVar  -- | Handle and serial configuration data SportCfg = SportCfg@@ -94,63 +75,50 @@     (S.rtimeout S.defSerialCfg)     (S.excl S.defSerialCfg) +-- | Acquire new handle 'newSportIO' then bracket+-- 'openSport' with a configuration to 'closeSport'.+withNewSport :: SportCfg -> (Sport -> IO a) -> IO a+withNewSport cfg k = do+  s <- newSportIO+  withSport s cfg $ k s++-- | Bracket 'openSport' and 'closeSport'.+withSport :: Sport -> SportCfg -> IO a -> IO a+withSport s cfg = bracket_ (openSport s cfg) (closeSport s)+ -- | Open the serial port. Throw 'SportAlreadyOpen' if the -- serial port was already opened. openSport :: Sport -> SportCfg -> IO ()-openSport s@(Sport state) cfg' = do-  res <- newEmptyTMVarIO-  atomically $ do-    cfgM <- getSportCfg s-    case cfgM of-      Nothing  -> writeTVar state $ Opening cfg' res-      Just cfg -> throwSTM $ SportAlreadyOpen $ path cfg-  atomically $ do-    result <- takeTMVar res-    case result of-      Left err -> throwSTM err-      Right () -> return ()+openSport s cfg' =+  bracketOnError (S.openSerial $ toSerialCfg cfg') hClose $ \serial -> do+    hSetBinaryMode serial $ binaryMode cfg'+    hSetBuffering  serial $ bufferMode cfg'+    atomically $ do+      cfgM <- getSportCfg s+      case cfgM of+        Just cfg -> throwSTM $ SportAlreadyOpen $ path cfg+        Nothing  -> do+          putTMVar (cfgVar  s) cfg'+          putTMVar (hndlVar s) serial  -- | Get current configuration. Returns 'Just' if--- the current state is opening or open. See also 'getOpenSportCfg'.+-- the current state is open. getSportCfg :: Sport -> STM (Maybe SportCfg)-getSportCfg (Sport s) = do-  st <- readTVar s-  return $ case st of-    Closed        -> Nothing-    Opening cfg _ -> Just cfg-    Open    cfg _ -> Just cfg---- | Get current open configuration. Returns 'Just' if--- the current state is open. See also 'getSportCfg'.-getOpenSportCfg :: Sport -> STM (Maybe SportCfg)-getOpenSportCfg (Sport s) = do-  st <- readTVar s-  return $ case st of-    Closed     -> Nothing-    Opening{}  -> Nothing-    Open cfg _ -> Just cfg+getSportCfg = tryReadTMVar . cfgVar  -- | Close the serial port. closeSport :: Sport -> IO ()-closeSport (Sport s) = join $ atomically $ do-  st <- readTVar s-  writeTVar s Closed-  closeState st--closeState :: State -> STM (IO ())-closeState Closed          = return $ return ()-closeState (Opening _ res) = closeResponse res $> return ()-closeState (Open _ serial) = return $ hClose serial--closeResponse :: TMVar (Either SomeException a) -> STM ()-closeResponse res = void $ tryPutTMVar res $ Left $ toException SportClosed+closeSport s = join $ atomically $ do+  _  <- tryTakeTMVar $ cfgVar  s+  hM <- tryTakeTMVar $ hndlVar s+  return $ mapM_ hClose hM  -- | Read n bytes from the serial port. If the serial port is -- closed then throw 'SportClosed'. Blocks until all n bytes -- are available. readSport :: Sport -> Int -> IO ByteString readSport s n = do-  h <- atomically $ readHandle s `orElse` throwSTM SportClosed+  h <- atomically $ readTMVar (hndlVar s) `orElse` throwSTM SportClosed   BS.hGet h n  -- | Read up to n bytes from the serial port. If the serial port@@ -158,7 +126,7 @@ -- the n bytes are available. readSomeSport :: Sport -> Int -> IO ByteString readSomeSport s n = do-  h <- atomically $ readHandle s `orElse` throwSTM SportClosed+  h <- atomically $ readTMVar (hndlVar s) `orElse` throwSTM SportClosed   BS.fromStrict <$> Strict.hGetSome h n  -- | Write bytes to the serial port. If the serial port@@ -166,54 +134,15 @@ -- port is busy handling a concurrent request. writeSport :: Sport -> ByteString -> IO () writeSport s bs = do-  h <- atomically $ readHandle s `orElse` throwSTM SportClosed+  h <- atomically $ readTMVar (hndlVar s) `orElse` throwSTM SportClosed   BS.hPut h bs  -- | Flush the serial handle. Do nothing if closed. flushSport :: Sport -> IO () flushSport s = do-  hM <- atomically $ tryReadHandle s+  hM <- atomically $ tryReadTMVar $ hndlVar s   mapM_ hFlush hM --- | Acquire a serial port and run the daemon.-withSport :: (Sport -> IO a) -> IO a-withSport k = do-  s <- newSportIO-  either id id <$> race (k s) (runSport s)---- | Construct the handle, run the daemon,--- and open the configured serial port. The serial port--- is closed on leaving scope.-withOpenSport :: SportCfg -> (Sport -> IO a) -> IO a-withOpenSport cfg k =-  withSport $ \s -> bracket_ (openSport s cfg) (closeSport s) (k s)---- | Run the serial port daemon and process requests.-runSport :: Sport -> IO a-runSport s@(Sport state) =-  forever (runState s =<< readTVarIO state) `onException` closeSport s--runState :: Sport -> State -> IO ()-runState s@(Sport state) st = case st of-  Closed -> waitNewState s st-  Opening cfg res ->-    handleException res $-      opening s cfg res-        `onException` atomically (writeTVar state Closed)-  Open{} -> waitNewState s st--waitNewState :: Sport -> State -> IO ()-waitNewState (Sport s) st = atomically $ check . (st /=) =<< readTVar s--opening :: Sport -> SportCfg -> TMVar (Either SomeException ()) -> IO ()-opening (Sport s) cfg res =-  bracketOnError (S.openSerial $ toSerialCfg cfg) hClose $ \serial -> do-    hSetBinaryMode serial $ binaryMode cfg-    hSetBuffering serial $ bufferMode cfg-    atomically $ do-      writeTVar s $ Open cfg serial-      writeTMVar res $ Right ()- toSerialCfg :: SportCfg -> S.SerialCfg toSerialCfg s =   S.SerialCfg@@ -224,12 +153,6 @@     (stopBits s)     (rtimeout s)     (excl s)--handleException :: TMVar (Either SomeException a) -> IO () -> IO ()-handleException res k = k `catches`-  [ Handler $ \e -> throwIO (e :: SomeAsyncException)-  , Handler $ \e -> atomically $ void $ tryPutTMVar res $ Left (e :: SomeException)-  ]  -- | Serial port exceptions data SportException

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               sport-version:            2.0.0.0+version:            3.0.0.0 synopsis:           UNIX serial port description:        Concurrent serial IO license:            MIT

@@ -10,16 +10,15 @@   hSetBuffering stdout NoBuffering   putStrLn "SPORT TEST"   s <- newSportIO-  race_ (runSport s) $ do-    putStr "OPENING..."-    openSport s defSportCfg{speed=B19200}-    putStrLn "DONE"-    let bs = BS.replicate 256 0xDC-    putStr "XFERING..."-    bs' <- fst <$> concurrently (readSport s 10) (writeSport s bs)-    putStrLn "DONE"-    putStr "COMPARING..."-    putStrLn $ if BS.take 10 bs == bs' then "PASS" else "FAIL"-    putStr "CLOSING..."-    closeSport s-    putStrLn "DONE"+  putStr "OPENING..."+  openSport s defSportCfg{speed=B19200}+  putStrLn "DONE"+  let bs = BS.replicate 256 0xDC+  putStr "XFERING..."+  bs' <- fst <$> concurrently (readSport s 10) (writeSport s bs)+  putStrLn "DONE"+  putStr "COMPARING..."+  putStrLn $ if BS.take 10 bs == bs' then "PASS" else "FAIL"+  putStr "CLOSING..."+  closeSport s+  putStrLn "DONE"