mateamt/src/Model/Journal.hs

184 lines
4.6 KiB
Haskell
Raw Normal View History

2019-08-09 18:56:57 +00:00
{-# LANGUAGE OverloadedStrings #-}
2019-10-14 20:50:42 +00:00
{-# LANGUAGE LambdaCase #-}
2019-08-09 18:56:57 +00:00
{-# LANGUAGE Arrows #-}
module Model.Journal where
2019-11-02 21:53:49 +00:00
import Data.Maybe (isJust, fromJust)
2019-08-10 08:36:20 +00:00
2019-08-09 18:56:57 +00:00
import Data.Time (UTCTime)
import Data.Time.Clock
import qualified Data.Text as T
import Data.Profunctor.Product (p5)
import qualified Database.PostgreSQL.Simple as PGS
import Control.Arrow
import Opaleye as O hiding (null, not)
import Opaleye.Constant as C
import Control.Monad.IO.Class (liftIO)
-- internal imports
import Types
initJournal :: PGS.Query
initJournal = mconcat
[ "CREATE TABLE IF NOT EXISTS \"journal\" ("
2019-08-10 08:36:20 +00:00
, "journal_id SERIAL NOT NULL,"
2019-08-09 18:56:57 +00:00
, "journal_timestamp TIMESTAMPTZ NOT NULL,"
, "journal_user INTEGER,"
, "journal_action INTEGER NOT NULL,"
2019-08-09 18:56:57 +00:00
, "journal_total_amount INTEGER NOT NULL,"
-- , "journal_entry_is_check BOOLEAN NOT NULL,"
2019-08-09 18:56:57 +00:00
, "PRIMARY KEY (journal_id)"
, ")"
]
journalTable :: Table
( Maybe (Field SqlInt4)
, Field SqlTimestamptz
, FieldNullable SqlInt4
2019-08-09 18:56:57 +00:00
, Field SqlInt4
, Field SqlInt4
-- , Field SqlBool
2019-08-09 18:56:57 +00:00
)
( Field SqlInt4
, Field SqlTimestamptz
, FieldNullable SqlInt4
, Field SqlInt4
2019-08-09 18:56:57 +00:00
, Field SqlInt4
-- , Field SqlBool
2019-08-09 18:56:57 +00:00
)
journalTable = table "journal" (
p5
( tableField "journal_id"
, tableField "journal_timestamp"
, tableField "journal_user"
, tableField "journal_action"
2019-08-10 08:36:20 +00:00
, tableField "journal_total_amount"
-- , tableField "journal_entry_is_check"
2019-08-09 18:56:57 +00:00
)
)
2019-08-10 08:36:20 +00:00
selectJournalEntries
:: Maybe Int -- limit
-> Maybe Int -- offset
-> PGS.Connection
-> MateHandler [JournalEntry]
selectJournalEntries mlimit moffset conn = liftIO $ do
let lim = case mlimit of
Just l -> limit (l + 1)
Nothing -> id
off = case moffset of
Just o -> offset o
Nothing -> id
entries <- runSelect conn
( proc () -> do
ret <- lim $ off $ orderBy (desc (\(id_, _, _, _, _) -> id_))
(queryTable journalTable) -< ()
returnA -< ret
) :: IO
[ ( Int
, UTCTime
, Maybe Int
, Int
2019-08-10 08:36:20 +00:00
, Int
)
]
return $ fst $ foldr
(\(id_, ts, user, action, tot) (fin, before)->
(JournalEntry id_ ts user (toEnum action) (tot - before) tot : fin, tot)
2019-08-10 08:36:20 +00:00
)
( []
2019-11-02 21:53:49 +00:00
, if isJust mlimit && length entries > fromJust mlimit
2019-08-10 08:36:20 +00:00
then (\(_, _, _, x, _) -> x) (last entries)
else 0
)
2019-11-02 21:53:49 +00:00
( if isJust mlimit && length entries > fromJust mlimit
2019-08-10 08:36:20 +00:00
then init entries
else entries
)
2019-08-09 18:56:57 +00:00
selectLatestJournalEntry
:: PGS.Connection
-> MateHandler (Maybe JournalEntry)
selectLatestJournalEntry conn = liftIO $ do
lastTwoEntries <- runSelect conn
( proc () -> do
ret <- limit 2 (orderBy (desc (\(id_, _, _, _, _) -> id_))
(queryTable journalTable)) -< ()
returnA -< ret
) :: IO
[ ( Int
, UTCTime
, Maybe Int
, Int
2019-08-09 18:56:57 +00:00
, Int
)
]
if not (null lastTwoEntries)
then do
let diff = foldl (\acc (_, _, _, _, tot) -> tot - acc) 0 lastTwoEntries
(jid, ts, user, action, total) = head lastTwoEntries
return $ Just $ JournalEntry jid ts user (toEnum action) diff total
2019-08-09 18:56:57 +00:00
else
return Nothing
insertNewJournalEntry
:: JournalSubmit
-> PGS.Connection
-> MateHandler Int
insertNewJournalEntry (JournalSubmit user action amount) conn = do
2019-10-14 20:50:42 +00:00
lastTotal <- (\case
2019-08-09 18:56:57 +00:00
Just j -> journalEntryTotalAmount j
Nothing -> 0
) <$> selectLatestJournalEntry conn
liftIO $ do
now <- getCurrentTime
fmap head $ runInsert_ conn $ Insert
{ iTable = journalTable
, iRows =
[
( C.constant (Nothing :: Maybe Int)
, C.constant now
, C.constant user
, C.constant (fromEnum action)
2019-08-09 18:56:57 +00:00
, C.constant (lastTotal + amount)
)
]
, iReturning = rReturning (\(id_, _, _, _, _) -> id_)
, iOnConflict = Nothing
}
2019-12-11 23:47:46 +00:00
insertNewCashCheck
:: JournalCashCheck
-> PGS.Connection
-> MateHandler Int
insertNewCashCheck (JournalCashCheck user amount) conn =
2019-12-11 23:47:46 +00:00
-- lastTotal <- (\case
-- Just j -> journalEntryTotalAmount j
-- Nothing -> 0
-- ) <$> selectLatestJournalEntry conn
liftIO $ do
now <- getCurrentTime
fmap head $ runInsert_ conn $ Insert
{ iTable = journalTable
, iRows =
[
( C.constant (Nothing :: Maybe Int)
, C.constant now
, C.constant (Just user)
, C.constant (fromEnum CashCheck)
2019-12-11 23:47:46 +00:00
, C.constant amount
)
]
, iReturning = rReturning (\(id_, _, _, _, _) -> id_)
, iOnConflict = Nothing
}