summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2018-01-23 11:23:14 -0800
committerBen Sima <ben@bsima.me>2018-01-23 11:23:14 -0800
commit61e0beb53ab923a862a7e4938787eaa710e31f51 (patch)
treef23d619ec5f19a89714c7af69dcc99d8326089bf
parent27c960910494b51a98d0d4d76bbdf49917198c0e (diff)
Use a bootstrap endpoint instead of bootstrapping on startup
This just demonstrates the code better, I wouldn't do this in production
-rwxr-xr-xmain.hs55
-rw-r--r--test.http8
2 files changed, 55 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))
diff --git a/test.http b/test.http
index 54bb4fd..c8bb3aa 100644
--- a/test.http
+++ b/test.http
@@ -12,10 +12,18 @@ User-Agent: Emacs
Content-Type: application/x-www-form-urlencoded
#
+# Initialize the database with exmaple data
+POST :host/bootstrap
+:headers
+
# should return 20 entries
GET :host/query
:headers
+# get the total number of records
+GET :host/count
+:headers
+
# store jenny's number
POST :host/number