From 75c38005222adaf800e19adf2e5669aa5ac323a0 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Mon, 22 Jan 2018 23:11:47 -0800 Subject: Startup with seed data and POST to db --- .gitignore | 3 ++- main.hs | 32 +++++++++++++++++++++++++++----- seed.csv | 1 + 3 files changed, 30 insertions(+), 6 deletions(-) create mode 100644 seed.csv 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 -- cgit v1.2.3