Use a bootstrap endpoint instead of bootstrapping on startup

This just demonstrates the code better, I wouldn't do this in production

1 files changed, 47 insertions, 8 deletions

diff --git a/main.hs b/main.hs
index ff2c0a1..5750c15 100755
--- a/main.hs
+++ b/main.hs
@@ -18,6 +18,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -151,8 +152,19 @@ callerByNumber num =
   do Database{..} <- ask
      return $ IxSet.toList $ callers @= num
 
+countCallers :: Query Database Int
+countCallers =
+  do Database{..} <- ask
+     return $ IxSet.size callers
 
-$(makeAcidic ''Database ['addCaller, 'updateCaller, 'callerById, 'callerByNumber, 'viewCallers])
+$(makeAcidic ''Database
+  ['addCaller
+  , 'updateCaller
+  , 'callerById
+  , 'callerByNumber
+  , 'viewCallers
+  , 'countCallers
+  ])
 
 
 -----------------------------------------------------------------------
@@ -163,7 +175,9 @@ data App = App
   }
 
 mkYesod "App" [parseRoutes|
+/bootstrap BootstrapR POST
 /query QueryR GET
+/count CountR GET
 /number NumberR POST
 |]
 
@@ -192,6 +206,13 @@ getQueryR = do
       caller <- liftIO $ query db $ CallerByNumber $ PhoneNumber q
       sendStatusJSON status200 $ object [ "results" .= caller ]
 
+getCountR :: Handler RepJson
+getCountR = do
+  app <- getYesod
+  let db = appState app
+  n <- liftIO $ query db $ CountCallers
+  sendStatusJSON status200 $ object [ "count" .= n ]
+
 data PostRequest = PostRequest
   { _name :: Text
   , _number :: Text
@@ -219,6 +240,31 @@ postNumberR = do
       caller <- liftIO $ update db $ AddCaller _name _number _context
       sendStatusJSON status200 $ caller
 
+-- | This takes a while; it's doing like 200 records per second. It's IO bound,
+-- and in an un-optimized program GHC on Linux uses a single, blocking IO
+-- manager thread (on Windows it's non-blocking, apparently). This can be
+-- improved with the Control.Concurrent module, it which case we could launch as
+-- many IO threads as we want, and do probably 10k records per second.
+--
+-- HOWEVER, you can watch it bootstrap. Hit this endpoint, then use "GET /count"
+-- to see it updating. New POSTs will also work and update the database, even
+-- while it is bootstrapping, which is kinda cool.
+postBootstrapR :: Handler RepJson
+postBootstrapR = do
+  $logInfo "Initializing the database."
+  app <- getYesod
+  let db = appState app
+  $logInfo "Loading data from CSV."
+  seedData <- liftIO $ BSL.readFile "interview-callerid-data.csv"
+  callers <- case Csv.decode Csv.NoHeader seedData of
+         Left err -> fail err
+         Right v ->
+           Vector.forM_ (Vector.indexed v) $ \(callerId, record) -> do
+           let (number, context, name) = record
+           c <- liftIO $ update db $ AddCaller name number context
+           return c
+  sendStatusJSON status200 $ callers
+
 
 -- | Start a simple warp server on 3000
 main :: IO ()
@@ -226,12 +272,5 @@ main = do
   bracket (openLocalState initDatabase)
           (createCheckpointAndClose)
           (\db -> do
-              seedData <- BSL.readFile "interview-callerid-data.csv"
-              case Csv.decode Csv.NoHeader seedData of
-                Left err -> fail err
-                Right v ->
-                  Vector.forM_ (Vector.indexed v) $ \(callerId, record) -> do
-                  let (number, context, name) = record
-                  update' db $ UpdateCaller $ Caller (CallerId callerId) name number context
               putStrLn "Ready"
               warp 3000 (App db))