diff options
author | Ben Sima <ben@bsima.me> | 2018-01-22 23:11:47 -0800 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2018-01-22 23:11:47 -0800 |
commit | 75c38005222adaf800e19adf2e5669aa5ac323a0 (patch) | |
tree | 71229dd475c752d0722f98b0d202806d351cbe56 | |
parent | ba9c21a8bed56cff3b9f875463d98e53871d51d9 (diff) |
Startup with seed data and POST to db
-rw-r--r-- | .gitignore | 3 | ||||
-rwxr-xr-x | main.hs | 32 | ||||
-rw-r--r-- | seed.csv | 1 |
3 files changed, 30 insertions, 6 deletions
@@ -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 @@ -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 |