Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Keep boxxy state

See #39
  • Loading branch information...
commit 9cdd47be90a87754c50bcb819622860ce2aa3898 1 parent ec65091
Jasper Van der Jeugt authored
5  count-von-count/count-von-count.yaml
@@ -61,3 +61,8 @@ boxxies:
61 61
       port: 8080
62 62
       path: ""
63 63
       key:  "tetten"
  64
+
  65
+    - host: "10.1.1.200"
  66
+      port: 8120
  67
+      path: ""
  68
+      key:  "sup"
57  count-von-count/src/CountVonCount/Boxxy.hs
@@ -5,19 +5,21 @@ module CountVonCount.Boxxy
5 5
       BoxxyConfig (..)
6 6
     , defaultBoxxyConfig
7 7
 
8  
-      -- * State
9  
-    , Boxxies
10  
-    , newBoxxies
11  
-
12 8
       -- * Talking to boxxy
13 9
     , putConfig
14 10
     , putLaps
15 11
     , putPosition
  12
+
  13
+      -- * Stateful talking
  14
+    , Boxxies
  15
+    , newBoxxies
  16
+    , withBoxxies
16 17
     ) where
17 18
 
18  
-import Control.Applicative ((<$>),(<*>))
19  
-import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, readMVar)
20  
-import Control.Monad (mzero)
  19
+import Control.Applicative (pure, (<$>),(<*>))
  20
+import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_)
  21
+import Control.Monad (mzero, when)
  22
+import Data.Maybe (isNothing)
21 23
 import Data.Time (UTCTime)
22 24
 
23 25
 import Data.Aeson (FromJSON (..), ToJSON (..), (.=), (.:?), (.!=))
@@ -28,8 +30,11 @@ import qualified Data.Text as T
28 30
 import qualified Data.Text.Encoding as T
29 31
 import qualified Network.HTTP.Conduit as Http
30 32
 
  33
+import CountVonCount.Log (Log)
31 34
 import CountVonCount.Persistence
32 35
 import CountVonCount.Types
  36
+import CountVonCount.Util
  37
+import qualified CountVonCount.Log as Log
33 38
 
34 39
 data BoxxyConfig = BoxxyConfig
35 40
     { boxxyHost :: Text
@@ -67,11 +72,6 @@ defaultBoxxyConfig = BoxxyConfig
67 72
     , boxxyKey  = "tetten"
68 73
     }
69 74
 
70  
-type Boxxies = MVar [(BoxxyConfig, Bool)]
71  
-
72  
-newBoxxies :: [BoxxyConfig] -> IO Boxxies
73  
-newBoxxies = newMVar . map (flip (,) False)
74  
-
75 75
 makeRequest :: ToJSON a => BoxxyConfig -> Text -> a -> IO ()
76 76
 makeRequest config path body = do
77 77
     let rq = Http.def
@@ -128,3 +128,36 @@ putPosition config team time station speed = makeRequest config path $ A.object
128 128
     ]
129 129
   where
130 130
     path = T.concat ["/", teamId team, "/position"]
  131
+
  132
+data State = Up | Down
  133
+    deriving (Eq, Show)
  134
+
  135
+data Boxxies = Boxxies
  136
+    { boxxiesState :: MVar [(BoxxyConfig, State)]
  137
+    , boxxiesInit  :: BoxxyConfig -> IO ()
  138
+    }
  139
+
  140
+newBoxxies :: [BoxxyConfig] -> (BoxxyConfig -> IO ()) -> IO Boxxies
  141
+newBoxxies configs init' = Boxxies
  142
+    <$> newMVar (map (flip (,) Down) configs)
  143
+    <*> pure init'
  144
+
  145
+withBoxxies :: Log
  146
+            -> Boxxies
  147
+            -> (BoxxyConfig -> IO ())
  148
+            -> IO ()
  149
+withBoxxies logger bs f = modifyMVar_ (boxxiesState bs) $ mapM $ \(c, s) -> do
  150
+    Log.string logger $ "Calling " ++ show c ++ ", currently " ++ show s
  151
+    -- Try to init if needed
  152
+    r <- case s of
  153
+        Down -> isolate logger "boxxy init" $ boxxiesInit bs c
  154
+        Up   -> return Nothing
  155
+
  156
+    -- Make the call if up
  157
+    r' <- case r of
  158
+        Nothing -> isolate logger "boxxy call" $ f c
  159
+        Just _  -> return r
  160
+
  161
+    let s' = if isNothing r' then Up else Down
  162
+    when (s /= s') $ Log.string logger $ show c ++ " is now " ++ show s'
  163
+    return (c, if isNothing r' then Up else Down)
25  count-von-count/src/CountVonCount/Main.hs
@@ -20,7 +20,6 @@ import CountVonCount.Persistence (Team (..), getAllTeams, runPersistence)
20 20
 import CountVonCount.Sensor
21 21
 import CountVonCount.Sensor.Filter
22 22
 import CountVonCount.Types
23  
-import CountVonCount.Util
24 23
 import qualified CountVonCount.Log as Log
25 24
 import qualified CountVonCount.Sensor as Sensor
26 25
 import qualified CountVonCount.Web as Web
@@ -38,10 +37,9 @@ main = do
38 37
     pubSub <- WS.newPubSub
39 38
 
40 39
     -- Initialize boxxy
41  
-    isolate_ logger "Initialize boxxy" $ do
42  
-        teams <- map snd <$> runPersistence getAllTeams
43  
-        forM_ (configBoxxies config) $ \boxxy -> putConfig boxxy
44  
-            (configCircuitLength config) (configStations config) teams
  40
+    boxxies <- newBoxxies (configBoxxies config) $ \b -> do
  41
+        ts <- map snd <$> runPersistence getAllTeams
  42
+        putConfig b (configCircuitLength config) (configStations config) ts
45 43
 
46 44
     -- Connecting the sensor to the counter
47 45
     sensorChan <- newChan
@@ -61,7 +59,7 @@ main = do
61 59
     _       <- forkIO $ runCounter counter (configCircuitLength config)
62 60
         (configMaxSpeed config) (Log.setModule "Counter" logger)
63 61
         (counterHandler (configCircuitLength config) logger
64  
-            (configBoxxies config) pubSub) sensorChan
  62
+            boxxies pubSub) sensorChan
65 63
 
66 64
     -- Start the baton watchdog
67 65
     _ <- forkIO $ watchdog counter logger (configBatonWatchdogInterval config)
@@ -69,14 +67,14 @@ main = do
69 67
         (handler "batonHandler" $
70 68
             WS.publish pubSub . WS.textData .  A.encode . Views.deadBatons)
71 69
 
72  
-    Web.listen config (Log.setModule "Web" logger) pubSub counter
  70
+    Web.listen config (Log.setModule "Web" logger) pubSub counter boxxies
73 71
 
74 72
     putStrLn "Closing..."
75 73
     Log.close replayLog
76 74
     Log.close logger
77 75
 
78 76
 counterHandler :: WS.TextProtocol p
79  
-               => Double -> Log -> [BoxxyConfig] -> WS.PubSub p
  77
+               => Double -> Log -> Boxxies -> WS.PubSub p
80 78
                -> Handler (Team, CounterState, CounterEvent)
81 79
 counterHandler circuitLength logger boxxies pubSub = handler "counterHandler" $
82 80
     \(team, cstate, event) -> do
@@ -84,11 +82,10 @@ counterHandler circuitLength logger boxxies pubSub = handler "counterHandler" $
84 82
         publish $ Views.counterState circuitLength team (Just cstate)
85 83
 
86 84
         -- Send to boxxies
87  
-        forM_ boxxies $ \boxxy -> isolate logger ("Boxxy " ++ show boxxy) $
88  
-            case event of
89  
-                Lap time speed                ->
90  
-                    putLaps boxxy team time 1 (Just speed) Nothing
91  
-                Progression time station speed ->
92  
-                    putPosition boxxy team time station speed
  85
+        withBoxxies logger boxxies $ \b -> case event of
  86
+            Lap time speed                 ->
  87
+                putLaps b team time 1 (Just speed) Nothing
  88
+            Progression time station speed ->
  89
+                putPosition b team time station speed
93 90
   where
94 91
     publish = WS.publish pubSub . WS.textData . A.encode
16  count-von-count/src/CountVonCount/Web.hs
@@ -4,7 +4,7 @@ module CountVonCount.Web
4 4
     ) where
5 5
 
6 6
 import Control.Applicative (pure, (<$>), (<*>), (<|>))
7  
-import Control.Monad (forM, unless, forM_)
  7
+import Control.Monad (forM, unless)
8 8
 import Control.Monad.Reader (ReaderT, ask, runReaderT)
9 9
 import Control.Monad.Trans (liftIO)
10 10
 import Data.Char (isDigit, isLower)
@@ -32,7 +32,6 @@ import CountVonCount.Management
32 32
 import CountVonCount.Persistence
33 33
 import CountVonCount.Web.Util
34 34
 import CountVonCount.Boxxy
35  
-import CountVonCount.Util
36 35
 import qualified CountVonCount.Log as Log
37 36
 import qualified CountVonCount.Web.Views as Views
38 37
 
@@ -41,6 +40,7 @@ data WebEnv = WebEnv
41 40
     , webLog     :: Log
42 41
     , webPubSub  :: WS.PubSub WS.Hybi00
43 42
     , webCounter :: Counter
  43
+    , webBoxxies :: Boxxies
44 44
     }
45 45
 
46 46
 type Web = ReaderT WebEnv Snap.Snap
@@ -142,14 +142,13 @@ teamBonus = do
142 142
     (view, result) <- runForm "bonus" bonusForm
143 143
     case result of
144 144
         Just (BonusForm laps' reason) -> do
145  
-            boxxies <- configBoxxies . webConfig <$> ask
  145
+            boxxies <- webBoxxies <$> ask
146 146
             logger  <- webLog <$> ask
147 147
 
148 148
             timestamp <- liftIO getCurrentTime
149 149
             team'     <- runPersistence $ addLaps teamRef timestamp reason laps'
150  
-            liftIO $ forM_ boxxies $ \boxxy ->
151  
-                isolate logger ("Boxxy " ++ show boxxy ++ " (bonus)") $
152  
-                    putLaps boxxy team' timestamp laps' Nothing (Just reason)
  150
+            liftIO $ withBoxxies logger boxxies $ \b ->
  151
+                putLaps b team' timestamp laps' Nothing (Just reason)
153 152
 
154 153
             Snap.redirect "/management"
155 154
         _ -> Snap.blaze $ Views.teamBonus teamRef team view
@@ -185,8 +184,8 @@ site = Snap.route
185 184
     , ("/team/:id/reset",      teamReset)
186 185
     ] <|> Snap.serveDirectory "static"
187 186
 
188  
-listen :: Config -> Log -> WS.PubSub WS.Hybi00 -> Counter -> IO ()
189  
-listen conf logger pubSub counter =
  187
+listen :: Config -> Log -> WS.PubSub WS.Hybi00 -> Counter -> Boxxies -> IO ()
  188
+listen conf logger pubSub counter boxxies =
190 189
     Snap.httpServe snapConfig $ runReaderT site env
191 190
   where
192 191
     env = WebEnv
@@ -194,6 +193,7 @@ listen conf logger pubSub counter =
194 193
         , webLog     = logger
195 194
         , webPubSub  = pubSub
196 195
         , webCounter = counter
  196
+        , webBoxxies = boxxies
197 197
         }
198 198
 
199 199
     snapConfig = Snap.setPort (configWebPort conf) Snap.defaultConfig
2  count-von-count/tests/CountVonCount/Util/Tests.hs
@@ -14,6 +14,6 @@ tests :: Test
14 14
 tests = testGroup "CountVonCount.Util.Tests"
15 15
     [ testCase "isolate test" $ assert $ do
16 16
         logger <- Log.open "/dev/null" False
17  
-        isolate logger "isolate test" $ fail "Sup guys"
  17
+        isolate_ logger "isolate test" $ fail "Sup guys"
18 18
         return True
19 19
     ]

0 notes on commit 9cdd47b

Please sign in to comment.
Something went wrong with that request. Please try again.