Show montly payments with an expandable mechanism

3 files changed, 36 insertions, 6 deletions

diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 7944ecd..25d3261 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -24,6 +24,7 @@ import Model.Payment
 import Model.Frequency
 import Model.Json.Message
 import Model.Json.Number
+import qualified Model.Json.PaymentId as JP
 import Model.Message
 import Model.Message.Key (Key(PaymentNotDeleted))
 
@@ -42,8 +43,8 @@ getMonthlyPaymentsAction =
 createPaymentAction :: Text -> Int -> Frequency -> ActionM ()
 createPaymentAction name cost frequency =
   Secure.loggedAction (\user -> do
-    _ <- liftIO . runDb $ createPayment (entityKey user) name cost frequency
-    status ok200
+    paymentId <- liftIO . runDb $ createPayment (entityKey user) name cost frequency
+    json (JP.PaymentId paymentId)
   )
 
 deletePaymentAction :: Text -> ActionM ()
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index 0af071e..098269b 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -54,6 +54,7 @@ global = do
       hover & transform (scale 1.2 1.2)
 
   ".payments" ? do
+    let inputHeight = 40
 
     ".exceedingPayers" ? do
       width (pct 95)
@@ -67,7 +68,6 @@ global = do
       ".exceedingPayer" Clay.** ".userName" ? marginRight (px 10)
 
     form # ".add" ? do
-      let inputHeight = 40
       width (pct 95)
       marginLeft auto
       marginRight auto
@@ -143,9 +143,21 @@ global = do
     ".monthlyPayments" ? do
       width (pct 95)
       margin (px 0) auto (px 45) auto
-      padding (px 10) (px 10) (px 10) (px 10)
-      backgroundColor C.lightGrey
-      borderRadius radius radius radius radius
+
+      button # ".count" ? do
+        width (pct 100)
+        defaultButton C.blue C.white inputHeight
+        borderRadius radius radius radius radius
+        textAlign (alignSide sideLeft)
+        position relative
+
+        ".expand" ? do
+          float floatRight
+          marginTop (px (-2))
+
+      ".detail" &
+        button # ".count" ?
+          borderRadius radius radius 0 0
 
     ".table" ? do
       display D.table
diff --git a/src/server/Model/Json/PaymentId.hs b/src/server/Model/Json/PaymentId.hs
new file mode 100644
index 0000000..3cbeb3c
--- /dev/null
+++ b/src/server/Model/Json/PaymentId.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Json.PaymentId
+  ( PaymentId(..)
+  ) where
+
+import Data.Aeson
+import GHC.Generics
+
+import qualified Model.Database as D
+
+data PaymentId = PaymentId
+  { id :: D.PaymentId
+  } deriving (Show, Generic)
+
+instance FromJSON PaymentId
+instance ToJSON PaymentId