summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2018-01-22 23:11:47 -0800
committerBen Sima <ben@bsima.me>2018-01-22 23:11:47 -0800
commit75c38005222adaf800e19adf2e5669aa5ac323a0 (patch)
tree71229dd475c752d0722f98b0d202806d351cbe56
parentba9c21a8bed56cff3b9f875463d98e53871d51d9 (diff)
Startup with seed data and POST to db
-rw-r--r--.gitignore3
-rwxr-xr-xmain.hs32
-rw-r--r--seed.csv1
3 files changed, 30 insertions, 6 deletions
diff --git a/.gitignore b/.gitignore
index 7d8757e..d2d48d5 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,3 @@
client_session_key.aes
-.stack-work \ No newline at end of file
+.stack-work
+database/ \ No newline at end of file
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)
diff --git a/seed.csv b/seed.csv
new file mode 100644
index 0000000..f11a0bb
--- /dev/null
+++ b/seed.csv
@@ -0,0 +1 @@
+5556780909,work,John Doe \ No newline at end of file