Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add isolate_ monad

  • Loading branch information...
commit ec650918694c23cf1299f0148ebc7da8f9f3497f 1 parent 36413bc
Jasper Van der Jeugt jaspervdj authored
10 count-von-count/src/CountVonCount/Boxxy.hs
View
@@ -5,6 +5,10 @@ module CountVonCount.Boxxy
BoxxyConfig (..)
, defaultBoxxyConfig
+ -- * State
+ , Boxxies
+ , newBoxxies
+
-- * Talking to boxxy
, putConfig
, putLaps
@@ -12,6 +16,7 @@ module CountVonCount.Boxxy
) where
import Control.Applicative ((<$>),(<*>))
+import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, readMVar)
import Control.Monad (mzero)
import Data.Time (UTCTime)
@@ -62,6 +67,11 @@ defaultBoxxyConfig = BoxxyConfig
, boxxyKey = "tetten"
}
+type Boxxies = MVar [(BoxxyConfig, Bool)]
+
+newBoxxies :: [BoxxyConfig] -> IO Boxxies
+newBoxxies = newMVar . map (flip (,) False)
+
makeRequest :: ToJSON a => BoxxyConfig -> Text -> a -> IO ()
makeRequest config path body = do
let rq = Http.def
2  count-von-count/src/CountVonCount/Counter.hs
View
@@ -70,7 +70,7 @@ step cl ms logger handler' event cmap = do
return cmap'
where
process _ [] = return ()
- process cstate events = isolate logger "CounterEvent process" $ do
+ process cstate events = isolate_ logger "CounterEvent process" $ do
mteam <- P.runPersistence $
P.getTeamByMac (batonMac . sensorBaton $ event)
2  count-von-count/src/CountVonCount/Main.hs
View
@@ -38,7 +38,7 @@ main = do
pubSub <- WS.newPubSub
-- Initialize boxxy
- isolate logger "Initialize boxxy" $ do
+ isolate_ logger "Initialize boxxy" $ do
teams <- map snd <$> runPersistence getAllTeams
forM_ (configBoxxies config) $ \boxxy -> putConfig boxxy
(configCircuitLength config) (configStations config) teams
4 count-von-count/src/CountVonCount/Sensor.hs
View
@@ -63,10 +63,10 @@ listen logger port handler' = do
forever $ do
(conn, _) <- S.accept sock
- _ <- forkIO $ isolate logger "Sensor send config" $ do
+ _ <- forkIO $ isolate_ logger "Sensor send config" $ do
S.sendAll conn "MSG,enable_rssi,true\r\n"
S.sendAll conn "MSG,enable_cache,false\r\n"
- _ <- forkIO $ isolate logger "Sensor receive" $ do
+ _ <- forkIO $ isolate_ logger "Sensor receive" $ do
E.run_ $ SE.enumSocket 256 conn $$
E.sequence (AE.iterParser gyrid) =$ receive logger handler'
S.sClose conn
2  count-von-count/src/CountVonCount/Types.hs
View
@@ -72,7 +72,7 @@ batonName = ("Baton " ++) . show . batonNr
data Handler a = Handler (Log -> a -> IO ())
handler :: String -> (a -> IO ()) -> Handler a
-handler name f = Handler $ \logger -> isolate logger ("Handler " ++ name) . f
+handler name f = Handler $ \logger -> isolate_ logger ("Handler " ++ name) . f
callHandler :: Log -> Handler a -> a -> IO ()
callHandler logger (Handler f) = f logger
16 count-von-count/src/CountVonCount/Util.hs
View
@@ -1,6 +1,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
module CountVonCount.Util
( isolate
+ , isolate_
) where
import qualified Control.Exception as E
@@ -8,12 +9,19 @@ import qualified Control.Exception as E
import CountVonCount.Log
-- | Isolate any exception in the given worker code and log it
-isolate :: Log -> String -> IO () -> IO ()
-isolate logger name worker = E.catches worker
+isolate :: Log -> String -> IO () -> IO (Maybe E.SomeException)
+isolate logger name worker = E.catches (worker >> return Nothing)
[ E.Handler $ \async -> case async of
E.UserInterrupt -> E.throw E.UserInterrupt
- _ -> isolate' async
+ _ -> isolate' (E.SomeException async)
, E.Handler $ \(ex :: E.SomeException) -> isolate' ex
]
where
- isolate' ex = string logger $ "[isolate " ++ name ++ "]: caught " ++ show ex
+ isolate' ex = do
+ string logger $ "[isolate " ++ name ++ "]: caught " ++ show ex
+ return (Just ex)
+
+isolate_ :: Log -> String -> IO () -> IO ()
+isolate_ logger name worker = do
+ _ <- isolate logger name worker
+ return ()
Please sign in to comment.
Something went wrong with that request. Please try again.