Optimize and refactor payments

5 files changed, 220 insertions, 156 deletions

diff --git a/server/src/Persistence/Category.hs b/server/src/Persistence/Category.hs
index 2afe5db..00cf0a5 100644
--- a/server/src/Persistence/Category.hs
+++ b/server/src/Persistence/Category.hs
@@ -5,7 +5,7 @@ module Persistence.Category
   , delete
   ) where
 
-import           Data.Maybe             (isJust, listToMaybe)
+import qualified Data.Maybe             as Maybe
 import           Data.Text              (Text)
 import           Data.Time.Clock        (getCurrentTime)
 import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
@@ -48,9 +48,9 @@ create categoryName categoryColor =
 edit :: CategoryId -> Text -> Text -> Query Bool
 edit categoryId categoryName categoryColor =
   Query (\conn -> do
-    mbCategory <- fmap (\(Row c) -> c) . listToMaybe <$>
+    mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$>
       (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
-    if isJust mbCategory
+    if Maybe.isJust mbCategory
       then do
         now <- getCurrentTime
         SQLite.execute
@@ -65,9 +65,9 @@ edit categoryId categoryName categoryColor =
 delete :: CategoryId -> Query Bool
 delete categoryId =
   Query (\conn -> do
-    mbCategory <- fmap (\(Row c) -> c) . listToMaybe <$>
+    mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$>
       (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
-    if isJust mbCategory
+    if Maybe.isJust mbCategory
       then do
         now <- getCurrentTime
         SQLite.execute
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
index cb2ef10..ba7ad19 100644
--- a/server/src/Persistence/Income.hs
+++ b/server/src/Persistence/Income.hs
@@ -2,17 +2,22 @@ module Persistence.Income
   ( count
   , list
   , listAll
+  , listModifiedSince
   , create
   , edit
   , delete
+  , definedForAll
   ) where
 
-import           Data.Maybe             (listToMaybe)
+import qualified Data.List              as L
+import qualified Data.Maybe             as Maybe
+import qualified Data.Text              as T
 import           Data.Time.Calendar     (Day)
+import           Data.Time.Clock        (UTCTime)
 import           Data.Time.Clock        (getCurrentTime)
 import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
 import qualified Database.SQLite.Simple as SQLite
-import           Prelude                hiding (id)
+import           Prelude                hiding (id, until)
 
 import           Common.Model           (Income (..), IncomeId, PaymentId,
                                          UserId)
@@ -31,15 +36,15 @@ instance FromRow Row where
     SQLite.field <*>
     SQLite.field)
 
-data Count = Count Int
+data CountRow = CountRow Int
 
-instance FromRow Count where
-  fromRow = Count <$> SQLite.field
+instance FromRow CountRow where
+  fromRow = CountRow <$> SQLite.field
 
 count :: Query Int
 count =
   Query (\conn ->
-    (\[Count n] -> n) <$>
+    (Maybe.fromMaybe 0 . fmap (\(CountRow n) -> n) . Maybe.listToMaybe) <$>
       SQLite.query_ conn "SELECT COUNT(*) FROM income WHERE deleted_at IS NULL"
   )
 
@@ -60,6 +65,23 @@ listAll =
       SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL"
   )
 
+listModifiedSince :: UTCTime -> Query [Income]
+listModifiedSince since =
+  Query (\conn ->
+    map (\(Row i) -> i) <$>
+      SQLite.query
+        conn
+        (SQLite.Query . T.intercalate " " $
+          [ "SELECT *"
+          , "FROM income"
+          , "WHERE"
+          ,   "created_at >= ?"
+          ,   "OR edited_at >= ?"
+          ,   "OR deleted_at >= ?"
+          ])
+        (Only since)
+  )
+
 create :: UserId -> Day -> Int -> Query Income
 create userId date amount =
   Query (\conn -> do
@@ -83,7 +105,7 @@ create userId date amount =
 edit :: UserId -> IncomeId -> Day -> Int -> Query (Maybe Income)
 edit userId incomeId incomeDate incomeAmount =
   Query (\conn -> do
-    mbIncome <- fmap (\(Row i) -> i) . listToMaybe <$>
+    mbIncome <- fmap (\(Row i) -> i) . Maybe.listToMaybe <$>
       SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
     case mbIncome of
       Just income ->
@@ -114,3 +136,26 @@ delete userId paymentId =
       "UPDATE income SET deleted_at = datetime('now') WHERE id = ? AND user_id = ?"
       (paymentId, userId)
   )
+
+data UserDayRow = UserDayRow (UserId, Day)
+
+instance FromRow UserDayRow where
+  fromRow = do
+    user <- SQLite.field
+    day <- SQLite.field
+    return $ UserDayRow (user, day)
+
+definedForAll :: [UserId] -> Query (Maybe Day)
+definedForAll users =
+  Query (\conn ->
+    (fromRows . fmap (\(UserDayRow (user, day)) -> (user, day))) <$>
+      SQLite.query_
+        conn
+        "SELECT user_id, MIN(date) FROM income WHERE deleted_at IS NULL GROUP BY user_id;"
+  )
+  where
+    fromRows rows =
+      if L.sort users == L.sort (map fst rows) then
+        Maybe.listToMaybe . L.sort . map snd $ rows
+      else
+        Nothing
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
index 7835c98..f75925d 100644
--- a/server/src/Persistence/Payment.hs
+++ b/server/src/Persistence/Payment.hs
@@ -1,33 +1,57 @@
 module Persistence.Payment
   ( count
   , find
-  , firstPunctualDay
-  , listActive
+  , getRange
   , listActivePage
-  , listPunctual
+  , listModifiedSince
   , listActiveMonthlyOrderedByName
   , create
   , createMany
   , edit
   , delete
+  , searchCategory
+  , repartition
+  , getPreAndPostPaymentRepartition
   ) where
 
-import           Data.Maybe                     (listToMaybe)
+import           Data.Map                       (Map)
+import qualified Data.Map                       as M
+import qualified Data.Maybe                     as Maybe
 import           Data.Text                      (Text)
 import qualified Data.Text                      as T
 import           Data.Time.Calendar             (Day)
+import qualified Data.Time.Calendar             as Calendar
+import           Data.Time.Clock                (UTCTime)
 import           Data.Time.Clock                (getCurrentTime)
 import           Database.SQLite.Simple         (FromRow (fromRow), Only (Only),
                                                  ToRow)
 import qualified Database.SQLite.Simple         as SQLite
 import           Database.SQLite.Simple.ToField (ToField (toField))
-import           Prelude                        hiding (id)
+import           Prelude                        hiding (id, until)
 
-import           Common.Model                   (Frequency (..), Payment (..),
-                                                 PaymentId, UserId)
+import           Common.Model                   (CategoryId, Frequency (..),
+                                                 Payment (..), PaymentId,
+                                                 User (..), UserId)
 
 import           Model.Query                    (Query (Query))
 import           Persistence.Frequency          (FrequencyField (..))
+import qualified Persistence.Income             as IncomePersistence
+
+
+
+fields :: Text
+fields = T.intercalate "," $
+  [ "id"
+  , "user_id"
+  , "name"
+  , "cost"
+  , "date"
+  , "category"
+  , "frequency"
+  , "created_at"
+  , "edited_at"
+  , "deleted_at"
+  ]
 
 newtype Row = Row Payment
 
@@ -38,6 +62,7 @@ instance FromRow Row where
     SQLite.field <*>
     SQLite.field <*>
     SQLite.field <*>
+    SQLite.field <*>
     (fmap (\(FrequencyField f) -> f) $ SQLite.field) <*>
     SQLite.field <*>
     SQLite.field <*>
@@ -51,6 +76,7 @@ instance ToRow InsertRow where
     , toField (_payment_name p)
     , toField (_payment_cost p)
     , toField (_payment_date p)
+    , toField (_payment_category p)
     , toField (FrequencyField (_payment_frequency p))
     , toField (_payment_createdAt p)
     ]
@@ -60,73 +86,94 @@ data Count = Count Int
 instance FromRow Count where
   fromRow = Count <$> SQLite.field
 
-count :: Query Int
-count =
+count :: Frequency -> Text -> Query Int
+count frequency search =
   Query (\conn ->
     (\[Count n] -> n) <$>
-      SQLite.query_ conn "SELECT COUNT(*) FROM payment WHERE deleted_at IS NULL"
+      SQLite.query
+        conn
+        (SQLite.Query $ T.intercalate " "
+          [ "SELECT COUNT(*)"
+          , "FROM payment"
+          , "WHERE"
+          ,   "deleted_at IS NULL"
+          ,   "AND frequency = ?"
+          ,   "AND name LIKE ?"
+          ])
+        (FrequencyField frequency, "%" <> search <> "%")
   )
 
 find :: PaymentId -> Query (Maybe Payment)
 find paymentId =
   Query (\conn -> do
-    fmap (\(Row p) -> p) . listToMaybe <$>
-      SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
+    fmap (\(Row p) -> p) . Maybe.listToMaybe <$>
+      SQLite.query
+        conn
+        (SQLite.Query $ "SELECT " <> fields <> " FROM payment WHERE id = ?")
+        (Only paymentId)
   )
 
-data DayRow = DayRow Day
+data RangeRow = RangeRow (Day, Day)
 
-instance FromRow DayRow where
-  fromRow = DayRow <$> SQLite.field
+instance FromRow RangeRow where
+  fromRow = (\f t -> RangeRow (f, t)) <$> SQLite.field <*> SQLite.field
 
-firstPunctualDay :: Query (Maybe Day)
-firstPunctualDay =
+getRange :: Query (Maybe (Day, Day))
+getRange =
   Query (\conn -> do
-    fmap (\(DayRow d) -> d) . listToMaybe <$>
+    fmap (\(RangeRow (f, t)) -> (f, t)) . Maybe.listToMaybe <$>
       SQLite.query
         conn
-        "SELECT date FROM payment WHERE frequency = ? AND deleted_at IS NULL ORDER BY date LIMIT 1"
+        (SQLite.Query $ T.intercalate " "
+          [ "SELECT MIN(date), MAX(date)"
+          , "FROM payment"
+          , "WHERE"
+          ,   "frequency = ?"
+          ,   "AND deleted_at IS NULL"
+          ])
         (Only (FrequencyField Punctual))
   )
 
-listActive :: Frequency -> Query [Payment]
-listActive frequency =
-  Query (\conn -> do
-    map (\(Row p) -> p) <$>
-      SQLite.query
-        conn
-        "SELECT * FROM payment WHERE deleted_at IS NULL AND frequency = ?"
-        (Only (FrequencyField frequency))
-  )
-
-listActivePage :: Int -> Int -> Query [Payment]
-listActivePage page perPage =
+listActivePage :: Frequency -> Int -> Int -> Text -> Query [Payment]
+listActivePage frequency page perPage search =
   Query (\conn ->
     map (\(Row p) -> p) <$>
       SQLite.query
         conn
         (SQLite.Query $ T.intercalate " "
-          [ "SELECT *"
+          [ "SELECT"
+          , fields
           , "FROM payment"
-          , "WHERE deleted_at IS NULL AND frequency = ?"
+          , "WHERE"
+          ,   "deleted_at IS NULL"
+          ,   "AND frequency = ?"
+          ,   "AND name LIKE ?"
           , "ORDER BY date DESC"
           , "LIMIT ?"
           , "OFFSET ?"
           ]
         )
-        (FrequencyField Punctual, perPage, (page - 1) * perPage)
+        (FrequencyField frequency, "%" <> search <> "%", perPage, (page - 1) * perPage)
   )
 
-listPunctual :: Query [Payment]
-listPunctual =
-  Query (\conn -> do
-    map (\(Row p) -> p) <$>
+listModifiedSince :: UTCTime -> Query [Payment]
+listModifiedSince since =
+  Query (\conn ->
+    map (\(Row i) -> i) <$>
       SQLite.query
         conn
-        (SQLite.Query "SELECT * FROM payment WHERE frequency = ?")
-        (Only (FrequencyField Punctual))
+        (SQLite.Query . T.intercalate " " $
+          [ "SELECT *"
+          , "FROM payment"
+          , "WHERE"
+          ,   "created_at >= ?"
+          ,   "OR edited_at >= ?"
+          ,   "OR deleted_at >= ?"
+          ])
+        (Only since)
   )
 
+
 listActiveMonthlyOrderedByName :: Query [Payment]
 listActiveMonthlyOrderedByName =
   Query (\conn -> do
@@ -134,7 +181,8 @@ listActiveMonthlyOrderedByName =
       SQLite.query
         conn
         (SQLite.Query $ T.intercalate " "
-          [ "SELECT *"
+          [ "SELECT"
+          , fields
           , "FROM payment"
           , "WHERE deleted_at IS NULL AND frequency = ?"
           , "ORDER BY name DESC"
@@ -142,17 +190,17 @@ listActiveMonthlyOrderedByName =
         (Only (FrequencyField Monthly))
   )
 
-create :: UserId -> Text -> Int -> Day -> Frequency -> Query Payment
-create userId name cost date frequency =
+create :: UserId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query Payment
+create userId name cost date category frequency =
   Query (\conn -> do
     time <- getCurrentTime
     SQLite.execute
       conn
       (SQLite.Query $ T.intercalate " "
-        [ "INSERT INTO payment (user_id, name, cost, date, frequency, created_at)"
-        , "VALUES (?, ?, ?, ?, ?, ?)"
+        [ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)"
+        , "VALUES (?, ?, ?, ?, ?, ?, ?)"
         ])
-      (userId, name, cost, date, FrequencyField frequency, time)
+      (userId, name, cost, date, category, FrequencyField frequency, time)
     paymentId <- SQLite.lastInsertRowId conn
     return $ Payment
       { _payment_id        = paymentId
@@ -160,6 +208,7 @@ create userId name cost date frequency =
       , _payment_name      = name
       , _payment_cost      = cost
       , _payment_date      = date
+      , _payment_category  = category
       , _payment_frequency = frequency
       , _payment_createdAt = time
       , _payment_editedAt  = Nothing
@@ -173,19 +222,19 @@ createMany payments =
     SQLite.executeMany
       conn
       (SQLite.Query $ T.intercalate ""
-        [ "INSERT INTO payment (user_id, name, cost, date, frequency, created_at)"
-        , "VALUES (?, ?, ?, ?, ?, ?)"
+        [ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)"
+        , "VALUES (?, ?, ?, ?, ?, ?, ?)"
         ])
       (map InsertRow payments)
   )
 
-edit :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query (Maybe (Payment, Payment))
-edit userId paymentId name cost date frequency =
+edit :: UserId -> PaymentId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query (Maybe Payment)
+edit userId paymentId name cost date category frequency =
   Query (\conn -> do
-    mbPayment <- fmap (\(Row p) -> p) . listToMaybe <$>
+    mbPayment <- fmap (\(Row p) -> p) . Maybe.listToMaybe <$>
       SQLite.query
         conn
-        "SELECT * FROM payment WHERE id = ? and user_id = ?"
+        (SQLite.Query $ "SELECT " <> fields <> " FROM payment WHERE id = ? and user_id = ?")
         (paymentId, userId)
     case mbPayment of
       Just payment -> do
@@ -200,6 +249,7 @@ edit userId paymentId name cost date frequency =
             , "  name = ?,"
             , "  cost = ?,"
             , "  date = ?,"
+            , "  category = ?,"
             , "  frequency = ?"
             , "WHERE"
             , "  id = ?"
@@ -209,16 +259,18 @@ edit userId paymentId name cost date frequency =
           , name
           , cost
           , date
+          , category
           , FrequencyField frequency
           , paymentId
           , userId
           )
-        return . Just . (,) payment $ Payment
+        return . Just $ Payment
           { _payment_id        = paymentId
           , _payment_user      = userId
           , _payment_name      = name
           , _payment_cost      = cost
           , _payment_date      = date
+          , _payment_category  = category
           , _payment_frequency = frequency
           , _payment_createdAt = _payment_createdAt payment
           , _payment_editedAt  = Just now
@@ -236,3 +288,59 @@ delete userId paymentId =
       "UPDATE payment SET deleted_at = datetime('now') WHERE id = ? AND user_id = ?"
       (paymentId, userId)
   )
+
+data CategoryIdRow = CategoryIdRow CategoryId
+
+instance FromRow CategoryIdRow where
+  fromRow = CategoryIdRow <$> SQLite.field
+
+searchCategory :: Text -> Query (Maybe CategoryId)
+searchCategory paymentName =
+  Query (\conn ->
+    fmap (\(CategoryIdRow d) -> d) . Maybe.listToMaybe <$>
+      SQLite.query
+        conn
+        "SELECT category FROM payment WHERE name LIKE ? LIMIT 1"
+        (Only $ "%" <> paymentName <> "%")
+  )
+
+data UserCostRow = UserCostRow (UserId, Int)
+
+instance FromRow UserCostRow where
+  fromRow = do
+    user <- SQLite.field
+    cost <- SQLite.field
+    return $ UserCostRow (user, cost)
+
+repartition :: Frequency -> Text -> Day -> Day -> Query (Map UserId Int)
+repartition frequency search from to =
+  Query (\conn ->
+    M.fromList . fmap (\(UserCostRow r) -> r) <$> SQLite.query
+      conn
+      (SQLite.Query . T.intercalate " " $
+        [ "SELECT user_id, SUM(cost)"
+        , "FROM payment"
+        , "WHERE"
+        ,   "deleted_at IS NULL"
+        ,   "AND frequency = ?"
+        ,   "AND name LIKE ?"
+        ,   "AND date >= ?"
+        ,   "AND date < ?"
+        , "GROUP BY user_id"
+        ])
+      (FrequencyField frequency, "%" <> search <> "%", from, to)
+  )
+
+getPreAndPostPaymentRepartition :: Maybe (Day, Day) -> [User] -> Query (Map UserId Int, Map UserId Int)
+getPreAndPostPaymentRepartition paymentRange users = do
+  case paymentRange of
+    Just (from, to) -> do
+      incomeDefinedForAll <- IncomePersistence.definedForAll (_user_id <$> users)
+      (,)
+        <$> (repartition Punctual "" from (Maybe.fromMaybe (Calendar.addDays 1 to) incomeDefinedForAll))
+        <*> (case incomeDefinedForAll of
+          Just d  -> repartition Punctual "" d (Calendar.addDays 1 to)
+          Nothing -> return M.empty)
+
+    Nothing ->
+      return (M.empty, M.empty)
diff --git a/server/src/Persistence/PaymentCategory.hs b/server/src/Persistence/PaymentCategory.hs
deleted file mode 100644
index 46be7f5..0000000
--- a/server/src/Persistence/PaymentCategory.hs
+++ /dev/null
@@ -1,89 +0,0 @@
-module Persistence.PaymentCategory
-  ( list
-  , listByCategory
-  , save
-  , deleteIfUnused
-  ) where
-
-import qualified Data.Maybe             as Maybe
-import           Data.Text              (Text)
-import qualified Data.Text              as T
-import           Data.Time.Clock        (getCurrentTime)
-import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
-import qualified Database.SQLite.Simple as SQLite
-
-import           Common.Model           (CategoryId, PaymentCategory (..))
-
-import           Model.Query            (Query (Query))
-
-newtype Row = Row PaymentCategory
-
-instance FromRow Row where
-  fromRow = Row <$> (PaymentCategory <$>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field)
-
-list :: Query [PaymentCategory]
-list =
-  Query (\conn -> do
-    map (\(Row pc) -> pc) <$>
-      SQLite.query_ conn "SELECT * from payment_category"
-  )
-
-listByCategory :: CategoryId -> Query [PaymentCategory]
-listByCategory cat =
-  Query (\conn -> do
-    map (\(Row pc) -> pc) <$>
-      SQLite.query conn "SELECT * FROM payment_category WHERE category = ?" (Only cat)
-  )
-
-save :: Text -> CategoryId -> Query PaymentCategory
-save newName categoryId =
-  Query (\conn -> do
-    now <- getCurrentTime
-    paymentCategory <- fmap (\(Row pc) -> pc) . Maybe.listToMaybe <$>
-      (SQLite.query
-        conn
-        "SELECT * FROM payment_category WHERE name = ?"
-        (Only formattedNewName))
-    case paymentCategory of
-      Just pc ->
-        do
-          SQLite.execute
-            conn
-            "UPDATE payment_category SET category = ?, edited_at = ? WHERE name = ?"
-            (categoryId, now, formattedNewName)
-          return $ PaymentCategory
-            (_paymentCategory_id pc)
-            formattedNewName
-            categoryId
-            (_paymentCategory_createdAt pc)
-            (Just now)
-      Nothing ->
-        do
-          SQLite.execute
-            conn
-            "INSERT INTO payment_category (name, category, created_at) VALUES (?, ?, ?)"
-            (formattedNewName, categoryId, now)
-          paymentCategoryId <- SQLite.lastInsertRowId conn
-          return $ PaymentCategory
-            paymentCategoryId
-            formattedNewName
-            categoryId
-            now
-            Nothing
-  )
-  where
-    formattedNewName = T.toLower newName
-
-deleteIfUnused :: Text -> Query ()
-deleteIfUnused name =
-  Query (\conn ->
-    SQLite.execute
-      conn
-      "DELETE FROM payment_category WHERE name = lower(?) AND name NOT IN (SELECT DISTINCT lower(name) FROM payment WHERE lower(name) = lower(?) AND deleted_at IS NULL)"
-      (name, name)
-  ) >> return ()
diff --git a/server/src/Persistence/User.hs b/server/src/Persistence/User.hs
index 4ec2dcf..3c3a2b1 100644
--- a/server/src/Persistence/User.hs
+++ b/server/src/Persistence/User.hs
@@ -3,7 +3,7 @@ module Persistence.User
   , get
   ) where
 
-import           Data.Maybe             (listToMaybe)
+import qualified Data.Maybe             as Maybe
 import           Data.Text              (Text)
 import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
 import qualified Database.SQLite.Simple as SQLite
@@ -32,6 +32,6 @@ list =
 get :: Text -> Query (Maybe User)
 get userEmail =
   Query (\conn -> do
-    fmap (\(Row u) -> u) . listToMaybe <$>
+    fmap (\(Row u) -> u) . Maybe.listToMaybe <$>
       SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail)
   )