diff options
Diffstat (limited to 'src/server/Model')
-rw-r--r-- | src/server/Model/Database.hs | 12 | ||||
-rw-r--r-- | src/server/Model/Job.hs | 27 | ||||
-rw-r--r-- | src/server/Model/JobKind.hs | 13 | ||||
-rw-r--r-- | src/server/Model/Payment.hs | 10 |
4 files changed, 56 insertions, 6 deletions
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs index d4a7d50..0bbc353 100644 --- a/src/server/Model/Database.hs +++ b/src/server/Model/Database.hs @@ -22,14 +22,15 @@ import Database.Persist.Sqlite import Database.Persist.TH import Model.Frequency +import Model.JobKind share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| User creation UTCTime email Text name Text - UniqEmail email - UniqName name + UniqUserEmail email + UniqUserName name deriving Show Payment userId UserId @@ -44,7 +45,12 @@ SignIn creation UTCTime email Text isUsed Bool - UniqToken token + UniqSignInToken token + deriving Show +Job + kind JobKind + lastExecution UTCTime Maybe + UniqJobName kind deriving Show |] diff --git a/src/server/Model/Job.hs b/src/server/Model/Job.hs new file mode 100644 index 0000000..3d5df96 --- /dev/null +++ b/src/server/Model/Job.hs @@ -0,0 +1,27 @@ +module Model.Job + ( getLastExecution + , actualizeLastExecution + ) where + +import Control.Monad.IO.Class (liftIO) + +import Data.Time.Clock (UTCTime, getCurrentTime) +import Data.Maybe (isJust) + +import Database.Persist + +import Model.Database +import Model.JobKind + +getLastExecution :: JobKind -> Persist (Maybe UTCTime) +getLastExecution kind = do + mbJob <- fmap entityVal <$> selectFirst [JobKind ==. kind] [] + return (mbJob >>= jobLastExecution) + +actualizeLastExecution :: JobKind -> Persist () +actualizeLastExecution kind = do + now <- liftIO getCurrentTime + jobKindDefined <- isJust <$> selectFirst [JobKind ==. kind] [] + if jobKindDefined + then updateWhere [JobKind ==. kind] [JobLastExecution =. Just now] + else insert (Job kind (Just now)) >> return () diff --git a/src/server/Model/JobKind.hs b/src/server/Model/JobKind.hs new file mode 100644 index 0000000..bbe1d45 --- /dev/null +++ b/src/server/Model/JobKind.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Model.JobKind + ( JobKind(..) + ) where + +import Database.Persist.TH + +data JobKind = + MonthlyPaymentJob + deriving (Eq, Show, Read) + +derivePersistField "JobKind" diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs index 381578a..f07cec4 100644 --- a/src/server/Model/Payment.hs +++ b/src/server/Model/Payment.hs @@ -1,5 +1,6 @@ module Model.Payment ( getPunctualPayments + , getUserMonthlyPayments , getMonthlyPayments , createPayment , deleteOwnPayment @@ -36,14 +37,17 @@ getPunctualPayments page perPage = do return (payment, user) return (map getJsonPayment xs) -getMonthlyPayments :: UserId -> Persist [P.Payment] -getMonthlyPayments userId = do +getUserMonthlyPayments :: UserId -> Persist [P.Payment] +getUserMonthlyPayments userId = + filter ((==) userId . P.userId) <$> getMonthlyPayments + +getMonthlyPayments :: Persist [P.Payment] +getMonthlyPayments = do xs <- select $ from $ \(payment `InnerJoin` user) -> do on (payment ^. PaymentUserId E.==. user ^. UserId) where_ (isNothing (payment ^. PaymentDeletedAt)) where_ (payment ^. PaymentFrequency E.==. val Monthly) - where_ (payment ^. PaymentUserId E.==. val userId) orderBy [desc (payment ^. PaymentCreation)] return (payment, user) return (map getJsonPayment xs) |