diff options
Diffstat (limited to 'server/src/Persistence/Income.hs')
| -rw-r--r-- | server/src/Persistence/Income.hs | 201 |
1 files changed, 201 insertions, 0 deletions
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs new file mode 100644 index 0000000..1b5364c --- /dev/null +++ b/server/src/Persistence/Income.hs @@ -0,0 +1,201 @@ +module Persistence.Income + ( listAll + , count + , list + , listModifiedSince + , create + , edit + , delete + , definedForAll + , getCumulativeIncome + ) where + +import qualified Data.List as L +import Data.Map (Map) +import qualified Data.Map as M +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), NamedParam ((:=))) +import qualified Database.SQLite.Simple as SQLite +import Prelude hiding (id, until) + +import Common.Model (Income (..), IncomeId, PaymentId, + UserId) + +import Model.Query (Query (Query)) + +newtype Row = Row Income + +instance FromRow Row where + fromRow = Row <$> (Income <$> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field) + +data CountRow = CountRow Int + +instance FromRow CountRow where + fromRow = CountRow <$> SQLite.field + +listAll :: Query [Income] +listAll = + Query (\conn -> + map (\(Row i) -> i) <$> + SQLite.query_ + conn + "SELECT * FROM income WHERE deleted_at IS NULL ORDER BY date DESC" + ) + + +count :: Query Int +count = + Query (\conn -> + (Maybe.fromMaybe 0 . fmap (\(CountRow n) -> n) . Maybe.listToMaybe) <$> + SQLite.query_ conn "SELECT COUNT(*) FROM income WHERE deleted_at IS NULL" + ) + +list :: Int -> Int -> Query [Income] +list page perPage = + Query (\conn -> + map (\(Row i) -> i) <$> + SQLite.queryNamed + conn + "SELECT * FROM income WHERE deleted_at IS NULL ORDER BY date DESC LIMIT :limit OFFSET :offset" + [ ":limit" := perPage + , ":offset" := (page - 1) * perPage + ] + ) + +listModifiedSince :: UTCTime -> Query [Income] +listModifiedSince since = + Query (\conn -> + map (\(Row i) -> i) <$> + SQLite.queryNamed + conn + (SQLite.Query . T.intercalate " " $ + [ "SELECT *" + , "FROM income" + , "WHERE" + , "created_at >= :since" + , "OR edited_at >= :since" + , "OR deleted_at >= :since" + ]) + [ ":since" := since ] + ) + +create :: UserId -> Day -> Int -> Query () +create userId date amount = + Query (\conn -> do + createdAt <- getCurrentTime + SQLite.executeNamed + conn + "INSERT INTO income (user_id, date, amount, created_at) VALUES (:userId, :date, :amount, :createdAt)" + [ ":userId" := userId + , ":date" := date + , ":amount" := amount + , ":createdAt" := createdAt + ] + ) + +edit :: UserId -> IncomeId -> Day -> Int -> Query Bool +edit userId id date amount = + Query (\conn -> do + income <- fmap (\(Row i) -> i) . Maybe.listToMaybe <$> + SQLite.queryNamed conn "SELECT * FROM income WHERE id = :id" [ ":id" := id ] + if Maybe.isJust income then + do + currentTime <- getCurrentTime + SQLite.executeNamed + conn + "UPDATE income SET edited_at = :editedAt, date = :date, amount = :amount WHERE id = :id AND user_id = :userId" + [ ":editedAt" := currentTime + , ":date" := date + , ":amount" := amount + , ":id" := id + , ":userId" := userId + ] + return True + else + return False + ) + +delete :: UserId -> PaymentId -> Query () +delete userId id = + Query (\conn -> + SQLite.executeNamed + conn + "UPDATE income SET deleted_at = datetime('now') WHERE id = :id AND user_id = :userId" + [ ":id" := id + , ":userId" := 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 . reverse . L.sort . map snd $ rows + else + Nothing + +getCumulativeIncome :: Day -> Day -> Query (Map UserId Int) +getCumulativeIncome start end = + Query (\conn -> M.fromList <$> SQLite.queryNamed conn (SQLite.Query query) parameters) + where + query = + T.intercalate "\n" $ + [ "SELECT user_id, CAST(ROUND(SUM(count)) AS INTEGER) FROM (" + , " SELECT" + , " I1.user_id," + , " ((JULIANDAY(MIN(I2.date)) - JULIANDAY(I1.date)) * I1.amount * 12 / 365) AS count" + , " FROM (" <> (selectBoundedIncomes ">" ":start") <> ") AS I1" + , " INNER JOIN (" <> (selectBoundedIncomes "<" ":end") <> ") AS I2" + , " ON I2.date > I1.date AND I2.user_id == I1.user_id" + , " GROUP BY I1.date, I1.user_id" + , ") GROUP BY user_id" + ] + + selectBoundedIncomes op param = + T.intercalate "\n" $ + [ " SELECT user_id, date, amount FROM (" + , " SELECT" + , " i.user_id, " <> param <> " AS date, i.amount" + , " FROM" + , " (SELECT id, MAX(date) AS max_date" + , " FROM income" + , " WHERE date <= " <> param <> " AND deleted_at IS NULL" + , " GROUP BY user_id) AS m" + , " INNER JOIN income AS i" + , " ON i.id = m.id AND i.date = m.max_date" + , " ) UNION" + , " SELECT user_id, date, amount" + , " FROM income" + , " WHERE date " <> op <> " " <> param <> " AND deleted_at IS NULL" + ] + + parameters = + [ ":start" := start + , ":end" := end + ] |