From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 8 Nov 2017 23:47:26 +0100
Subject: Use a better project structure

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

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

diff --git a/server/src/Main.hs b/server/src/Main.hs
new file mode 100644
index 0000000..db73474
--- /dev/null
+++ b/server/src/Main.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Control.Applicative (liftA3)
+import Control.Monad.IO.Class (liftIO)
+
+import Network.Wai.Middleware.Static
+import qualified Data.Text.Lazy as LT
+import Web.Scotty
+
+import qualified Conf
+import qualified Controller.Category as Category
+import qualified Controller.Income as Income
+import qualified Controller.Index as Index
+import qualified Controller.Payment as Payment
+import qualified Controller.SignIn as SignIn
+import Job.Daemon (runDaemons)
+import Model.Payer (getOrderedExceedingPayers)
+import qualified Data.Time as Time
+import qualified Model.User as UserM
+import qualified Model.Income as IncomeM
+import qualified Model.Payment as PaymentM
+import qualified Model.Query as Query
+
+main :: IO ()
+main = do
+  conf <- Conf.get "application.conf"
+  _ <- runDaemons conf
+  scotty (Conf.port conf) $ do
+    middleware . staticPolicy $ noDots >-> addBase "public"
+
+    get "/exceedingPayer" $ do
+      time <- liftIO Time.getCurrentTime
+      (users, incomes, payments) <- liftIO . Query.run $
+        liftA3 (,,) UserM.list IncomeM.list PaymentM.list
+      let exceedingPayers = getOrderedExceedingPayers time users incomes payments
+      text . LT.pack . show $ exceedingPayers
+
+    get "/" $ do
+      signInToken <- mbParam "signInToken"
+      Index.get conf signInToken
+
+    post "/signIn" $ do
+      jsonData >>= SignIn.signIn conf
+
+    post "/signOut" $
+      Index.signOut conf
+
+    post "/payment" $
+      jsonData >>= Payment.create
+
+    put "/payment" $
+      jsonData >>= Payment.editOwn
+
+    delete "/payment" $ do
+      paymentId <- param "id"
+      Payment.deleteOwn paymentId
+
+    post "/income" $
+      jsonData >>= Income.create
+
+    put "/income" $
+      jsonData >>= Income.editOwn
+
+    delete "/income" $ do
+      incomeId <- param "id"
+      Income.deleteOwn incomeId
+
+    post "/category" $
+      jsonData >>= Category.create
+
+    put "/category" $
+      jsonData >>= Category.edit
+
+    delete "/category" $ do
+      categoryId <- param "id"
+      Category.delete categoryId
+
+mbParam :: Parsable a => LT.Text -> ActionM (Maybe a)
+mbParam key = (Just <$> param key) `rescue` (const . return $ Nothing)
-- 
cgit v1.2.3