diff options
| -rwxr-xr-x | main.hs | 55 | ||||
| -rw-r--r-- | test.http | 8 |
2 files changed, 55 insertions, 8 deletions
@@ -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)) @@ -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 |