From 898e7ed11ab0958fcdaf65b99b33f7b04787630a Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 24 Sep 2017 22:14:48 +0200
Subject: Bootstrap with GHCJS and reflex:

- setup login and logout,
- first draft of payment view.
---
 src/server/Main.hs | 21 ++++++++++++++++++---
 1 file changed, 18 insertions(+), 3 deletions(-)

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

diff --git a/src/server/Main.hs b/src/server/Main.hs
index 17c2594..db73474 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -1,16 +1,25 @@
 {-# 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 Job.Daemon (runDaemons)
 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
@@ -19,13 +28,19 @@ main = do
   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
-      email <- param "email"
-      SignIn.signIn conf email
+      jsonData >>= SignIn.signIn conf
 
     post "/signOut" $
       Index.signOut conf
-- 
cgit v1.2.3


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

---
 src/server/Main.hs | 79 ------------------------------------------------------
 1 file changed, 79 deletions(-)
 delete mode 100644 src/server/Main.hs

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

diff --git a/src/server/Main.hs b/src/server/Main.hs
deleted file mode 100644
index db73474..0000000
--- a/src/server/Main.hs
+++ /dev/null
@@ -1,79 +0,0 @@
-{-# 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