commence cotrolify

mateamt.cabal

@@ -23,6 +23,9 @@ flag develop
 executable mateamt
   main-is:             Main.hs
   other-modules:       API
+                     , Control
+                     , Control.Buy
+                     , Control.Journal
                      , Model
                      , Model.User
                      , Model.Product

src/Control.hs

@@ -0,0 +1,6 @@
+module Control
+  ( module C
+  ) where
+
+import Control.Buy as C
+import Control.Journal as C

src/Control/Buy.hs

@@ -0,0 +1,78 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Control.Buy where
+
+import Servant
+
+import Control.Monad (void, foldM)
+
+import Control.Monad.Reader (ask)
+
+-- internal imports
+
+import Types
+import Model
+
+buy
+  :: Maybe Int
+  -> [PurchaseDetail]
+  -> MateHandler PurchaseResult
+buy (Just auid) pds = do
+  conn <- rsConnection <$> ask
+  (missing, real) <- foldM (\acc@(ms, rs) pd -> do
+    mmiss <- checkProductAvailability pd conn
+    case mmiss of
+      Just miss -> return
+        ( (pd {purchaseDetailAmount = miss}):ms
+        , (pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs)
+        )
+      Nothing -> return
+        ( ms
+        , pd:rs
+        )
+    )
+    ([], [])
+    pds
+  void $ mapM_ (\pd -> postBuyProductAmountUpdate pd conn) real
+  price <- foldM
+    (\total pd ->
+      fmap (+ total) (getLatestTotalPrice pd conn)
+    )
+    0
+    real
+  addToUserBalance auid (-price) conn
+  newBalance <- userBalanceSelect conn auid
+  return $ PurchaseResult
+    ( if newBalance < 0
+      then PurchaseDebtful
+      else PurchaseOK
+    )
+    missing
+buy Nothing pds = do
+  conn <- rsConnection <$> ask
+  (missing, real) <- foldM (\acc@(ms, rs) pd -> do
+    mmiss <- checkProductAvailability pd conn
+    case mmiss of
+      Just miss -> return
+        ( (pd {purchaseDetailAmount = miss}):ms
+        , (pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs)
+        )
+      Nothing -> return
+        ( ms
+        , pd:rs
+        )
+    )
+    ([], [])
+    pds
+  void $ mapM_
+    (\pd -> postBuyProductAmountUpdate pd conn)
+    real
+  price <- foldM
+    (\total pd ->
+      fmap (+ total) (getLatestTotalPrice pd conn)
+    )
+    0
+    real
+  void $ insertNewJournalEntry (JournalSubmit "Cash purchase" price) conn
+  return $ PurchaseResult
+    (PayAmount price)
+    missing

src/Control/Journal.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Control.Journal where
+
+import Servant
+
+import Control.Monad.Reader (ask)
+
+-- internal imports
+
+import Types
+import Model.Journal
+
+journalShow
+  :: Maybe Int
+  -> Maybe Int
+  -> Maybe Int
+  -> MateHandler [JournalEntry]
+journalShow (Just _) mlimit moffset = do
+  conn <- rsConnection <$> ask
+  selectJournalEntries mlimit moffset conn
+journalShow Nothing _ _ =
+  throwError $ err403
+    { errBody = "No Authentication present"
+    }

src/Main.hs

@@ -39,6 +39,7 @@ import API
 import Model as M
 
 import Types
+import Control
 
 main :: IO ()
 main = do
@@ -226,64 +227,3 @@ productList :: MateHandler [ProductOverview]
 productList = do
   conn <- rsConnection <$> ask
   productOverviewSelect conn
-
-
-buy (Just auid) pds = do
-  conn <- rsConnection <$> ask
-  (missing, real) <- foldM (\acc@(ms, rs) pd -> do
-    mmiss <- checkProductAvailability pd conn
-    case mmiss of
-      Just miss -> return
-        ( (pd {purchaseDetailAmount = miss}):ms
-        , (pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs)
-        )
-      Nothing -> return
-        ( ms
-        , pd:rs
-        )
-    )
-    ([], [])
-    pds
-  void $ mapM_ (\pd -> postBuyProductAmountUpdate pd conn) real
-  price <- foldM
-    (\total pd ->
-      fmap (+ total) (getLatestTotalPrice pd conn)
-    )
-    0
-    real
-  addToUserBalance auid (-price) conn
-  newBalance <- userBalanceSelect conn auid
-  return $ PurchaseResult
-    ( if newBalance < 0
-      then PurchaseDebtful
-      else PurchaseOK
-    )
-    missing
-buy Nothing pds = do
-  conn <- rsConnection <$> ask
-  (missing, real) <- foldM (\acc@(ms, rs) pd -> do
-    mmiss <- checkProductAvailability pd conn
-    case mmiss of
-      Just miss -> return
-        ( (pd {purchaseDetailAmount = miss}):ms
-        , (pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs)
-        )
-      Nothing -> return
-        ( ms
-        , pd:rs
-        )
-    )
-    ([], [])
-    pds
-  void $ mapM_
-    (\pd -> postBuyProductAmountUpdate pd conn)
-    real
-  price <- foldM
-    (\total pd ->
-      fmap (+ total) (getLatestTotalPrice pd conn)
-    )
-    0
-    real
-  return $ PurchaseResult
-    (PayAmount price)
-    missing