diff options
Diffstat (limited to 'server/src/Persistence/Income.hs')
| -rw-r--r-- | server/src/Persistence/Income.hs | 201 |
1 files changed, 0 insertions, 201 deletions
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs deleted file mode 100644 index 1b5364c..0000000 --- a/server/src/Persistence/Income.hs +++ /dev/null @@ -1,201 +0,0 @@ -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 - ] |