From 75c38005222adaf800e19adf2e5669aa5ac323a0 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Mon, 22 Jan 2018 23:11:47 -0800
Subject: Startup with seed data and POST to db

---
 main.hs | 32 +++++++++++++++++++++++++++-----
 1 file changed, 27 insertions(+), 5 deletions(-)

(limited to 'main.hs')

diff --git a/main.hs b/main.hs
index 75d9cfd..6d785c1 100755
--- a/main.hs
+++ b/main.hs
@@ -10,6 +10,7 @@
      --package text
      --package aeson
      --package acid-state
+     --package cassava
 -}
 
 {-# LANGUAGE DeriveDataTypeable #-}
@@ -22,8 +23,11 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 import Data.Acid
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.Csv as Csv
 import Data.SafeCopy
 import Data.Semigroup
+import qualified Data.Vector as Vector
 import Data.Data (Data, Typeable)
 import GHC.Generics
 import Control.Monad
@@ -31,7 +35,7 @@ import Control.Monad.Reader (ask)
 import Control.Monad.State (get, put)
 import Data.Maybe (isJust)
 import Data.Text hiding (take)
-import Yesod hiding (Update, get)
+import Yesod hiding (Update, update, get)
 import Network.HTTP.Types.Status (status400, status200)
 import Data.Aeson
 
@@ -73,6 +77,8 @@ $(makeAcidic ''Database ['addCaller, 'viewCallers])
 -- | Here be the HTTP stuff
 
 data App = App
+  { appState :: AcidState Database
+  }
 
 mkYesod "App" [parseRoutes|
 /query QueryR GET
@@ -104,14 +110,30 @@ getQueryR = do
 
 postNumberR :: Handler RepJson
 postNumberR = do
-  (obj :: Result Value) <- parseJsonBody
+  (obj :: Result Caller) <- parseJsonBody
   case obj of
     Error err ->
       sendStatusJSON status400 $ ApiError $ "Invalid request. Could not parse JSON body: " <> pack err
 
-    Success v ->
-      sendStatusJSON status200 $ object [ "msg" .= ("FIXME" :: Text) ]
+    Success caller -> do
+      app <- getYesod
+      let db = appState app
+      liftIO $ update db $ AddCaller caller
+      sendStatusJSON status200 $ caller
+
 
 -- | Start a simple warp server on 3000
 main :: IO ()
-main = warp 3000 App
+main = do
+  seedData <- BSL.readFile "seed.csv"
+  database <- openLocalStateFrom "database/" (Database [])
+  case Csv.decode Csv.NoHeader seedData of
+    Left err ->
+      fail err
+
+    Right v ->
+      Vector.forM_ v $ \(number, context, name) -> do
+        update database $ AddCaller $ Caller name number context
+        putStrLn $ unpack $ name <> number <> context
+
+  warp 3000 (App database)
-- 
cgit v1.2.3