summaryrefslogtreecommitdiff
path: root/main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'main.hs')
-rwxr-xr-xmain.hs32
1 files changed, 27 insertions, 5 deletions
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)