summaryrefslogtreecommitdiff
path: root/main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'main.hs')
-rwxr-xr-xmain.hs25
1 files changed, 5 insertions, 20 deletions
diff --git a/main.hs b/main.hs
index a09c9ce..04acafc 100755
--- a/main.hs
+++ b/main.hs
@@ -28,6 +28,7 @@
{-# LANGUAGE RecordWildCards #-}
import Data.Acid
+import Data.Acid.Advanced (groupUpdates)
import Data.Acid.Local (createCheckpointAndClose)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Csv as Csv
@@ -240,21 +241,9 @@ postNumberR = do
caller <- liftIO $ update db $ AddCaller _name _number _context
sendStatusJSON status200 $ caller
--- | This takes a while; on my machine it averages 181 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. There's
--- definitely an optimal amount of threads here, we'd have to test to find that.
---
--- 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.
---
--- Try this in bash:
---
--- while sleep 1; do curl -s "localhost:3000/count" | jq '.count'; done
---
+
+callerFromCsv (number, context, name) = AddCaller name number context
+
postBootstrapR :: Handler RepJson
postBootstrapR = do
$logInfo "Initializing the database."
@@ -264,11 +253,7 @@ postBootstrapR = do
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
+ Right v -> liftIO $ groupUpdates db $ Vector.toList $ Vector.map callerFromCsv v
sendStatusJSON status200 $ ("Bootstrap complete." :: Text)