diff options
Diffstat (limited to 'server/src/Model')
-rw-r--r-- | server/src/Model/Category.hs | 16 | ||||
-rw-r--r-- | server/src/Model/Frequency.hs | 21 | ||||
-rw-r--r-- | server/src/Model/Income.hs | 18 | ||||
-rw-r--r-- | server/src/Model/Init.hs | 14 | ||||
-rw-r--r-- | server/src/Model/Mail.hs | 8 | ||||
-rw-r--r-- | server/src/Model/Payer.hs | 31 | ||||
-rw-r--r-- | server/src/Model/Payment.hs | 34 | ||||
-rw-r--r-- | server/src/Model/PaymentCategory.hs | 18 | ||||
-rw-r--r-- | server/src/Model/Query.hs | 4 | ||||
-rw-r--r-- | server/src/Model/SignIn.hs | 24 | ||||
-rw-r--r-- | server/src/Model/UUID.hs | 6 | ||||
-rw-r--r-- | server/src/Model/User.hs | 16 |
12 files changed, 109 insertions, 101 deletions
diff --git a/server/src/Model/Category.hs b/server/src/Model/Category.hs index 6b7a488..b972ebd 100644 --- a/server/src/Model/Category.hs +++ b/server/src/Model/Category.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Model.Category @@ -8,16 +8,16 @@ module Model.Category , delete ) where -import Data.Maybe (isJust, listToMaybe) -import Data.Text (Text) -import Data.Time.Clock (getCurrentTime) -import Database.SQLite.Simple (Only(Only), FromRow(fromRow)) +import Data.Maybe (isJust, listToMaybe) +import Data.Text (Text) +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) -import Common.Model (Category(..), CategoryId) +import Common.Model (Category (..), CategoryId) -import Model.Query (Query(Query)) +import Model.Query (Query (Query)) instance FromRow Category where fromRow = Category <$> diff --git a/server/src/Model/Frequency.hs b/server/src/Model/Frequency.hs index b334a40..41a325d 100644 --- a/server/src/Model/Frequency.hs +++ b/server/src/Model/Frequency.hs @@ -1,22 +1,23 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Model.Frequency () where -import Database.SQLite.Simple (SQLData(SQLText)) -import Database.SQLite.Simple.FromField (fieldData, FromField(fromField)) -import Database.SQLite.Simple.Ok (Ok(Ok, Errors)) -import Database.SQLite.Simple.ToField (ToField(toField)) -import qualified Data.Text as T +import qualified Data.Text as T +import Database.SQLite.Simple (SQLData (SQLText)) +import Database.SQLite.Simple.FromField (FromField (fromField), + fieldData) +import Database.SQLite.Simple.Ok (Ok (Errors, Ok)) +import Database.SQLite.Simple.ToField (ToField (toField)) -import Common.Model (Frequency) +import Common.Model (Frequency) instance FromField Frequency where fromField field = case fieldData field of SQLText text -> Ok (read (T.unpack text) :: Frequency) - _ -> Errors [error "SQLText field required for frequency"] + _ -> Errors [error "SQLText field required for frequency"] instance ToField Frequency where toField frequency = SQLText . T.pack . show $ frequency diff --git a/server/src/Model/Income.hs b/server/src/Model/Income.hs index bbe7657..a69112a 100644 --- a/server/src/Model/Income.hs +++ b/server/src/Model/Income.hs @@ -9,17 +9,19 @@ module Model.Income , modifiedDuring ) where -import Data.Maybe (listToMaybe) -import Data.Time.Calendar (Day) -import Data.Time.Clock (UTCTime, getCurrentTime) -import Database.SQLite.Simple (Only(Only), FromRow(fromRow)) -import Prelude hiding (id) +import Data.Maybe (listToMaybe) +import Data.Time.Calendar (Day) +import Data.Time.Clock (UTCTime, getCurrentTime) +import Database.SQLite.Simple (FromRow (fromRow), Only (Only)) import qualified Database.SQLite.Simple as SQLite +import Prelude hiding (id) -import Common.Model (Income(..), IncomeId, User(..), UserId) +import Common.Model (Income (..), IncomeId, User (..), + UserId) -import Model.Query (Query(Query)) -import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt) +import Model.Query (Query (Query)) +import Resource (Resource, resourceCreatedAt, + resourceDeletedAt, resourceEditedAt) instance Resource Income where resourceCreatedAt = _income_createdAt diff --git a/server/src/Model/Init.hs b/server/src/Model/Init.hs index 8c6a961..c030c58 100644 --- a/server/src/Model/Init.hs +++ b/server/src/Model/Init.hs @@ -4,16 +4,16 @@ module Model.Init ( getInit ) where -import Common.Model (Init(Init), User(..)) +import Common.Model (Init (Init), User (..)) -import Conf (Conf) +import Conf (Conf) import qualified Conf -import Model.Query (Query) -import qualified Model.Category as Category -import qualified Model.Income as Income -import qualified Model.Payment as Payment +import qualified Model.Category as Category +import qualified Model.Income as Income +import qualified Model.Payment as Payment import qualified Model.PaymentCategory as PaymentCategory -import qualified Model.User as User +import Model.Query (Query) +import qualified Model.User as User getInit :: User -> Conf -> Query Init getInit user conf = diff --git a/server/src/Model/Mail.hs b/server/src/Model/Mail.hs index 9a4db73..a19f9ae 100644 --- a/server/src/Model/Mail.hs +++ b/server/src/Model/Mail.hs @@ -2,11 +2,11 @@ module Model.Mail ( Mail(..) ) where -import Data.Text (Text) +import Data.Text (Text) data Mail = Mail - { from :: Text - , to :: [Text] - , subject :: Text + { from :: Text + , to :: [Text] + , subject :: Text , plainBody :: Text } deriving (Eq, Show) diff --git a/server/src/Model/Payer.hs b/server/src/Model/Payer.hs index de4abd1..db3f37c 100644 --- a/server/src/Model/Payer.hs +++ b/server/src/Model/Payer.hs @@ -2,14 +2,15 @@ module Model.Payer ( getOrderedExceedingPayers ) where -import Data.Map (Map) -import Data.Time (UTCTime(..), NominalDiffTime) -import qualified Data.List as List -import qualified Data.Map as Map -import qualified Data.Maybe as Maybe -import qualified Data.Time as Time +import qualified Data.List as List +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Maybe as Maybe +import Data.Time (NominalDiffTime, UTCTime (..)) +import qualified Data.Time as Time -import Common.Model (User(..), UserId, Income(..), IncomeId, Payment(..)) +import Common.Model (Income (..), IncomeId, Payment (..), User (..), + UserId) type Users = Map UserId User @@ -20,20 +21,20 @@ type Incomes = Map IncomeId Income type Payments = [Payment] data Payer = Payer - { preIncomePaymentSum :: Int + { preIncomePaymentSum :: Int , postIncomePaymentSum :: Int - , _incomes :: [Income] + , _incomes :: [Income] } data PostPaymentPayer = PostPaymentPayer { _preIncomePaymentSum :: Int - , _cumulativeIncome :: Int - , ratio :: Float + , _cumulativeIncome :: Int + , ratio :: Float } data ExceedingPayer = ExceedingPayer { _userId :: UserId - , amount :: Int + , amount :: Int } deriving (Show) getOrderedExceedingPayers :: UTCTime -> [User] -> [Income] -> Payments -> [ExceedingPayer] @@ -72,7 +73,7 @@ useIncomesFrom users incomes payments = mbIncomeTime = incomeDefinedForAll (Map.keys users) incomes in case (firstPaymentTime, mbIncomeTime) of (Just t1, Just t2) -> Just (max t1 t2) - _ -> Nothing + _ -> Nothing paymentTime :: Payment -> UTCTime paymentTime = flip UTCTime (Time.secondsToDiffTime 0) . _payment_date @@ -95,7 +96,7 @@ getPayers currentTime users incomes payments = (\p -> case incomesDefined of Nothing -> False - Just t -> paymentTime p >= t + Just t -> paymentTime p >= t ) userId payments @@ -197,7 +198,7 @@ nominalDay :: NominalDiffTime nominalDay = 86400 safeHead :: [a] -> Maybe a -safeHead [] = Nothing +safeHead [] = Nothing safeHead (x : _) = Just x safeMinimum :: (Ord a) => [a] -> Maybe a diff --git a/server/src/Model/Payment.hs b/server/src/Model/Payment.hs index 14efe77..c1b109f 100644 --- a/server/src/Model/Payment.hs +++ b/server/src/Model/Payment.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Model.Payment @@ -13,22 +13,26 @@ module Model.Payment , modifiedDuring ) where -import Data.Maybe (listToMaybe) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Time (UTCTime) -import Data.Time.Calendar (Day) -import Data.Time.Clock (getCurrentTime) -import Database.SQLite.Simple (Only(Only), FromRow(fromRow), ToRow) -import Database.SQLite.Simple.ToField (ToField(toField)) -import Prelude hiding (id) -import qualified Database.SQLite.Simple as SQLite +import Data.Maybe (listToMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time (UTCTime) +import Data.Time.Calendar (Day) +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 Common.Model (Frequency(..), Payment(..), PaymentId, UserId) +import Common.Model (Frequency (..), Payment (..), + PaymentId, UserId) -import Model.Frequency () -import Model.Query (Query(Query)) -import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt) +import Model.Frequency () +import Model.Query (Query (Query)) +import Resource (Resource, resourceCreatedAt, + resourceDeletedAt, + resourceEditedAt) instance Resource Payment where resourceCreatedAt = _payment_createdAt diff --git a/server/src/Model/PaymentCategory.hs b/server/src/Model/PaymentCategory.hs index 6e1d304..6d02136 100644 --- a/server/src/Model/PaymentCategory.hs +++ b/server/src/Model/PaymentCategory.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Model.PaymentCategory @@ -7,17 +7,17 @@ module Model.PaymentCategory , save ) where -import Data.Maybe (isJust, listToMaybe) -import Data.Text (Text) -import Data.Time.Clock (getCurrentTime) -import Database.SQLite.Simple (Only(Only), FromRow(fromRow)) -import qualified Data.Text as T +import Data.Maybe (isJust, listToMaybe) +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 qualified Common.Util.Text as T +import Common.Model (CategoryId, PaymentCategory (..)) +import qualified Common.Util.Text as T -import Model.Query (Query(Query)) +import Model.Query (Query (Query)) instance FromRow PaymentCategory where fromRow = PaymentCategory <$> diff --git a/server/src/Model/Query.hs b/server/src/Model/Query.hs index d15fb5f..22ae95b 100644 --- a/server/src/Model/Query.hs +++ b/server/src/Model/Query.hs @@ -3,8 +3,8 @@ module Model.Query , run ) where -import Data.Functor (Functor) -import Database.SQLite.Simple (Connection) +import Data.Functor (Functor) +import Database.SQLite.Simple (Connection) import qualified Database.SQLite.Simple as SQLite data Query a = Query (Connection -> IO a) diff --git a/server/src/Model/SignIn.hs b/server/src/Model/SignIn.hs index c5182f0..6f38fe7 100644 --- a/server/src/Model/SignIn.hs +++ b/server/src/Model/SignIn.hs @@ -8,25 +8,25 @@ module Model.SignIn , isLastTokenValid ) where -import Data.Int (Int64) -import Data.Maybe (listToMaybe) -import Data.Text (Text) -import Data.Time.Clock (getCurrentTime) -import Data.Time.Clock (UTCTime) -import Database.SQLite.Simple (Only(Only), FromRow(fromRow)) +import Data.Int (Int64) +import Data.Maybe (listToMaybe) +import Data.Text (Text) +import Data.Time.Clock (getCurrentTime) +import Data.Time.Clock (UTCTime) +import Database.SQLite.Simple (FromRow (fromRow), Only (Only)) import qualified Database.SQLite.Simple as SQLite -import Model.Query (Query(Query)) -import Model.UUID (generateUUID) +import Model.Query (Query (Query)) +import Model.UUID (generateUUID) type SignInId = Int64 data SignIn = SignIn - { id :: SignInId - , token :: Text + { id :: SignInId + , token :: Text , creation :: UTCTime - , email :: Text - , isUsed :: Bool + , email :: Text + , isUsed :: Bool } deriving Show instance FromRow SignIn where diff --git a/server/src/Model/UUID.hs b/server/src/Model/UUID.hs index 6cb7ce0..0959a8e 100644 --- a/server/src/Model/UUID.hs +++ b/server/src/Model/UUID.hs @@ -2,9 +2,9 @@ module Model.UUID ( generateUUID ) where -import Data.UUID (toString) -import Data.UUID.V4 (nextRandom) -import Data.Text (Text, pack) +import Data.Text (Text, pack) +import Data.UUID (toString) +import Data.UUID.V4 (nextRandom) generateUUID :: IO Text generateUUID = pack . toString <$> nextRandom diff --git a/server/src/Model/User.hs b/server/src/Model/User.hs index e14fcef..f17f545 100644 --- a/server/src/Model/User.hs +++ b/server/src/Model/User.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Model.User @@ -8,16 +8,16 @@ module Model.User , delete ) where -import Data.Maybe (listToMaybe) -import Data.Text (Text) -import Data.Time.Clock (getCurrentTime) -import Database.SQLite.Simple (Only(Only), FromRow(fromRow)) -import Prelude hiding (id) +import Data.Maybe (listToMaybe) +import Data.Text (Text) +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 Common.Model (UserId, User(..)) +import Common.Model (User (..), UserId) -import Model.Query (Query(Query)) +import Model.Query (Query (Query)) instance FromRow User where fromRow = User <$> SQLite.field <*> SQLite.field <*> SQLite.field <*> SQLite.field |