From 4ce9751c9e645916fdde71874c2cdadd252f32a0 Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Mon, 6 Jul 2015 00:16:45 +0200
Subject: Setting up Scotty, Persistent, Clay, Blaze, Esqueleto, Elm

---
 src/server/Application.hs | 62 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100644 src/server/Application.hs

(limited to 'src/server/Application.hs')

diff --git a/src/server/Application.hs b/src/server/Application.hs
new file mode 100644
index 0000000..344b38c
--- /dev/null
+++ b/src/server/Application.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Application
+  ( getIndexAction
+  , getUsersAction
+  , getPaymentsAction
+  , addUserAction
+  , deleteUserAction
+  , insertPaymentAction
+  ) where
+
+import Web.Scotty
+
+import Network.HTTP.Types.Status (badRequest400)
+
+import Database.Persist
+
+import Control.Monad.IO.Class (liftIO)
+
+import Data.Text (Text)
+import Data.String (fromString)
+
+import Model.Database (runDb)
+import Model.User
+import Model.Payment
+
+import View.Page (page)
+
+getIndexAction :: ActionM ()
+getIndexAction = do
+  html $ page
+
+getUsersAction :: ActionM ()
+getUsersAction = do
+  users <- liftIO $ runDb getUsers
+  html . fromString . show $ users
+
+getPaymentsAction :: ActionM ()
+getPaymentsAction = do
+  payments <- liftIO $ runDb getPayments
+  json payments
+
+addUserAction :: Text -> Text -> ActionM ()
+addUserAction email name = do
+  _ <- liftIO . runDb $ insertUser email name
+  html "Ok"
+
+deleteUserAction :: Text -> ActionM ()
+deleteUserAction email = do
+  _ <- liftIO . runDb $ deleteUser email
+  html "Ok"
+
+insertPaymentAction :: Text -> Text -> Int -> ActionM ()
+insertPaymentAction email name cost = do
+  maybeUser <- liftIO . runDb $ getUser email
+  case maybeUser of
+    Just user -> do
+      _ <- liftIO . runDb $ insertPayment (entityKey user) name cost
+      return ()
+    Nothing -> do
+      status badRequest400
+      html "Not found"
-- 
cgit v1.2.3