From 898e7ed11ab0958fcdaf65b99b33f7b04787630a Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 24 Sep 2017 22:14:48 +0200
Subject: Bootstrap with GHCJS and reflex:

- setup login and logout,
- first draft of payment view.
---
 src/server/Model/Category.hs             |  23 +-
 src/server/Model/Frequency.hs            |  23 +-
 src/server/Model/Income.hs               |  32 +-
 src/server/Model/Init.hs                 |  31 +-
 src/server/Model/Json/Category.hs        |  24 -
 src/server/Model/Json/Conf.hs            |  17 -
 src/server/Model/Json/CreateCategory.hs  |  17 -
 src/server/Model/Json/CreateIncome.hs    |  17 -
 src/server/Model/Json/CreatePayment.hs   |  23 -
 src/server/Model/Json/EditCategory.hs    |  19 -
 src/server/Model/Json/EditIncome.hs      |  20 -
 src/server/Model/Json/EditPayment.hs     |  25 --
 src/server/Model/Json/Income.hs          |  26 --
 src/server/Model/Json/Init.hs            |  36 --
 src/server/Model/Json/MessagePart.hs     |  18 -
 src/server/Model/Json/Number.hs          |  15 -
 src/server/Model/Json/Payment.hs         |  40 --
 src/server/Model/Json/PaymentCategory.hs |  23 -
 src/server/Model/Json/Translation.hs     |  20 -
 src/server/Model/Json/User.hs            |  25 --
 src/server/Model/Message.hs              |  35 --
 src/server/Model/Message/Key.hs          | 193 --------
 src/server/Model/Message/Lang.hs         |  11 -
 src/server/Model/Message/Parts.hs        |  37 --
 src/server/Model/Message/Translations.hs | 729 -------------------------------
 src/server/Model/Payer.hs                | 216 +++++++++
 src/server/Model/Payment.hs              |  59 +--
 src/server/Model/PaymentCategory.hs      |  24 +-
 src/server/Model/User.hs                 |  31 +-
 29 files changed, 289 insertions(+), 1520 deletions(-)
 delete mode 100644 src/server/Model/Json/Category.hs
 delete mode 100644 src/server/Model/Json/Conf.hs
 delete mode 100644 src/server/Model/Json/CreateCategory.hs
 delete mode 100644 src/server/Model/Json/CreateIncome.hs
 delete mode 100644 src/server/Model/Json/CreatePayment.hs
 delete mode 100644 src/server/Model/Json/EditCategory.hs
 delete mode 100644 src/server/Model/Json/EditIncome.hs
 delete mode 100644 src/server/Model/Json/EditPayment.hs
 delete mode 100644 src/server/Model/Json/Income.hs
 delete mode 100644 src/server/Model/Json/Init.hs
 delete mode 100644 src/server/Model/Json/MessagePart.hs
 delete mode 100644 src/server/Model/Json/Number.hs
 delete mode 100644 src/server/Model/Json/Payment.hs
 delete mode 100644 src/server/Model/Json/PaymentCategory.hs
 delete mode 100644 src/server/Model/Json/Translation.hs
 delete mode 100644 src/server/Model/Json/User.hs
 delete mode 100644 src/server/Model/Message.hs
 delete mode 100644 src/server/Model/Message/Key.hs
 delete mode 100644 src/server/Model/Message/Lang.hs
 delete mode 100644 src/server/Model/Message/Parts.hs
 delete mode 100644 src/server/Model/Message/Translations.hs
 create mode 100644 src/server/Model/Payer.hs

(limited to 'src/server/Model')

diff --git a/src/server/Model/Category.hs b/src/server/Model/Category.hs
index 9597bd9..6b7a488 100644
--- a/src/server/Model/Category.hs
+++ b/src/server/Model/Category.hs
@@ -1,34 +1,23 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Model.Category
-  ( CategoryId
-  , Category(..)
-  , list
+  ( list
   , create
   , edit
   , delete
   ) where
 
-import Data.Int (Int64)
 import Data.Maybe (isJust, listToMaybe)
 import Data.Text (Text)
-import Data.Time (UTCTime)
 import Data.Time.Clock (getCurrentTime)
 import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
 import qualified Database.SQLite.Simple as SQLite
+import Prelude hiding (id)
 
-import Model.Query (Query(Query))
-
-type CategoryId = Int64
+import Common.Model (Category(..), CategoryId)
 
-data Category = Category
-  { id :: CategoryId
-  , name :: Text
-  , color :: Text
-  , createdAt :: UTCTime
-  , editedAt :: Maybe UTCTime
-  , deletedAt :: Maybe UTCTime
-  } deriving Show
+import Model.Query (Query(Query))
 
 instance FromRow Category where
   fromRow = Category <$>
diff --git a/src/server/Model/Frequency.hs b/src/server/Model/Frequency.hs
index f9958e1..4f7b83d 100644
--- a/src/server/Model/Frequency.hs
+++ b/src/server/Model/Frequency.hs
@@ -1,28 +1,17 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
-module Model.Frequency
-  ( Frequency(..)
-  ) where
+module Model.Frequency () where
 
-import Data.Aeson
 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 GHC.Generics
 import qualified Data.Text as T
-import Web.Scotty (parseParam, Parsable, readEither)
 
-data Frequency =
-  Punctual
-  | Monthly
-  deriving (Eq, Show, Read, Generic)
-
-instance Parsable Frequency where parseParam = readEither
-instance FromJSON Frequency
-instance ToJSON Frequency
+import Common.Model.Frequency (Frequency)
 
 instance FromField Frequency where
   fromField field = case fieldData field of
diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
index c6cdb55..bbe7657 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -1,16 +1,14 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Model.Income
-  ( IncomeId
-  , Income(..)
-  , list
+  ( list
   , create
   , editOwn
   , deleteOwn
   , modifiedDuring
   ) where
 
-import Data.Int (Int64)
 import Data.Maybe (listToMaybe)
 import Data.Time.Calendar (Day)
 import Data.Time.Clock (UTCTime, getCurrentTime)
@@ -18,27 +16,15 @@ import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
 import Prelude hiding (id)
 import qualified Database.SQLite.Simple as SQLite
 
+import Common.Model (Income(..), IncomeId, User(..), UserId)
+
 import Model.Query (Query(Query))
-import Model.User (User, UserId)
-import qualified Model.User as User
 import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
 
-type IncomeId = Int64
-
-data Income = Income
-  { id :: IncomeId
-  , userId :: UserId
-  , date :: Day
-  , amount :: Int
-  , createdAt :: UTCTime
-  , editedAt :: Maybe UTCTime
-  , deletedAt :: Maybe UTCTime
-  } deriving Show
-
 instance Resource Income where
-  resourceCreatedAt = createdAt
-  resourceEditedAt = editedAt
-  resourceDeletedAt = deletedAt
+  resourceCreatedAt = _income_createdAt
+  resourceEditedAt = _income_editedAt
+  resourceDeletedAt = _income_deletedAt
 
 instance FromRow Income where
   fromRow = Income <$>
@@ -70,7 +56,7 @@ editOwn incomeUserId incomeId incomeDate incomeAmount =
     mbIncome <- listToMaybe <$> SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
     case mbIncome of
       Just income ->
-        if userId income == incomeUserId
+        if _income_userId income == incomeUserId
           then do
             now <- getCurrentTime
             SQLite.execute
@@ -90,7 +76,7 @@ deleteOwn user incomeId =
     mbIncome <- listToMaybe <$> SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
     case mbIncome of
       Just income ->
-        if userId income == User.id user
+        if _income_userId income == _user_id user
           then do
             now <- getCurrentTime
             SQLite.execute conn "UPDATE income SET deleted_at = ? WHERE id = ?" (now, incomeId)
diff --git a/src/server/Model/Init.hs b/src/server/Model/Init.hs
index 7a9ccea..8c6a961 100644
--- a/src/server/Model/Init.hs
+++ b/src/server/Model/Init.hs
@@ -4,27 +4,24 @@ module Model.Init
   ( getInit
   ) where
 
-import Model.Json.Init (Init)
+import Common.Model (Init(Init), User(..))
+
+import Conf (Conf)
+import qualified Conf
 import Model.Query (Query)
-import Model.User (User)
 import qualified Model.Category as Category
 import qualified Model.Income as Income
-import qualified Model.Json.Category as Json
-import qualified Model.Json.Income as Json
-import qualified Model.Json.Init as Init
-import qualified Model.Json.Payment as Json
-import qualified Model.Json.PaymentCategory as Json
-import qualified Model.Json.User as Json
 import qualified Model.Payment as Payment
 import qualified Model.PaymentCategory as PaymentCategory
 import qualified Model.User as User
 
-getInit :: User -> Query Init
-getInit user =
-  Init.Init <$>
-    (map Json.fromUser <$> User.list) <*>
-    (return . User.id $ user) <*>
-    (map Json.fromPayment <$> Payment.list) <*>
-    (map Json.fromIncome <$> Income.list) <*>
-    (map Json.fromCategory <$> Category.list) <*>
-    (map Json.fromPaymentCategory <$> PaymentCategory.list)
+getInit :: User -> Conf -> Query Init
+getInit user conf =
+  Init <$>
+    User.list <*>
+    (return . _user_id $ user) <*>
+    Payment.list <*>
+    Income.list <*>
+    Category.list <*>
+    PaymentCategory.list <*>
+    (return . Conf.currency $ conf)
diff --git a/src/server/Model/Json/Category.hs b/src/server/Model/Json/Category.hs
deleted file mode 100644
index 8b5e527..0000000
--- a/src/server/Model/Json/Category.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Category
-  ( Category(..)
-  , fromCategory
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import GHC.Generics
-
-import Model.Category (CategoryId)
-import qualified Model.Category as M
-
-data Category = Category
-  { id :: CategoryId
-  , name :: Text
-  , color :: Text
-  } deriving (Show, Generic)
-
-instance ToJSON Category
-
-fromCategory :: M.Category -> Category
-fromCategory category = Category (M.id category) (M.name category) (M.color category)
diff --git a/src/server/Model/Json/Conf.hs b/src/server/Model/Json/Conf.hs
deleted file mode 100644
index a66fb55..0000000
--- a/src/server/Model/Json/Conf.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Conf
-  ( Conf(..)
-  ) where
-
-import GHC.Generics
-
-import Data.Aeson
-import Data.Text
-
-data Conf = Conf
-  { currency :: Text
-  } deriving (Show, Generic)
-
-instance FromJSON Conf
-instance ToJSON Conf
diff --git a/src/server/Model/Json/CreateCategory.hs b/src/server/Model/Json/CreateCategory.hs
deleted file mode 100644
index fffc882..0000000
--- a/src/server/Model/Json/CreateCategory.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.CreateCategory
-  ( CreateCategory(..)
-  ) where
-
-import GHC.Generics
-
-import Data.Aeson
-import Data.Text (Text)
-
-data CreateCategory = CreateCategory
-  { name :: Text
-  , color :: Text
-  } deriving (Show, Generic)
-
-instance FromJSON CreateCategory
diff --git a/src/server/Model/Json/CreateIncome.hs b/src/server/Model/Json/CreateIncome.hs
deleted file mode 100644
index cf9b1c3..0000000
--- a/src/server/Model/Json/CreateIncome.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.CreateIncome
-  ( CreateIncome(..)
-  ) where
-
-import GHC.Generics
-
-import Data.Aeson
-import Data.Time.Calendar (Day)
-
-data CreateIncome = CreateIncome
-  { date :: Day
-  , amount :: Int
-  } deriving (Show, Generic)
-
-instance FromJSON CreateIncome
diff --git a/src/server/Model/Json/CreatePayment.hs b/src/server/Model/Json/CreatePayment.hs
deleted file mode 100644
index 6ab3a5b..0000000
--- a/src/server/Model/Json/CreatePayment.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.CreatePayment
-  ( CreatePayment(..)
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import Data.Time.Calendar (Day)
-import GHC.Generics
-
-import Model.Category (CategoryId)
-import Model.Frequency (Frequency)
-
-data CreatePayment = CreatePayment
-  { name :: Text
-  , cost :: Int
-  , date :: Day
-  , category :: CategoryId
-  , frequency :: Frequency
-  } deriving (Show, Generic)
-
-instance FromJSON CreatePayment
diff --git a/src/server/Model/Json/EditCategory.hs b/src/server/Model/Json/EditCategory.hs
deleted file mode 100644
index a10ce39..0000000
--- a/src/server/Model/Json/EditCategory.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.EditCategory
-  ( EditCategory(..)
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import GHC.Generics
-
-import Model.Category (CategoryId)
-
-data EditCategory = EditCategory
-  { id :: CategoryId
-  , name :: Text
-  , color :: Text
-  } deriving (Show, Generic)
-
-instance FromJSON EditCategory
diff --git a/src/server/Model/Json/EditIncome.hs b/src/server/Model/Json/EditIncome.hs
deleted file mode 100644
index 9b29379..0000000
--- a/src/server/Model/Json/EditIncome.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.EditIncome
-  ( EditIncome(..)
-  ) where
-
-import GHC.Generics
-
-import Data.Aeson
-import Data.Time.Calendar (Day)
-
-import Model.Income (IncomeId)
-
-data EditIncome = EditIncome
-  { id :: IncomeId
-  , date :: Day
-  , amount :: Int
-  } deriving (Show, Generic)
-
-instance FromJSON EditIncome
diff --git a/src/server/Model/Json/EditPayment.hs b/src/server/Model/Json/EditPayment.hs
deleted file mode 100644
index b7d4d7d..0000000
--- a/src/server/Model/Json/EditPayment.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.EditPayment
-  ( EditPayment(..)
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import Data.Time.Calendar (Day)
-import GHC.Generics
-
-import Model.Category (CategoryId)
-import Model.Frequency (Frequency)
-import Model.Payment (PaymentId)
-
-data EditPayment = EditPayment
-  { id :: PaymentId
-  , name :: Text
-  , cost :: Int
-  , date :: Day
-  , category :: CategoryId
-  , frequency :: Frequency
-  } deriving (Show, Generic)
-
-instance FromJSON EditPayment
diff --git a/src/server/Model/Json/Income.hs b/src/server/Model/Json/Income.hs
deleted file mode 100644
index 7e23a84..0000000
--- a/src/server/Model/Json/Income.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Income
-  ( Income(..)
-  , fromIncome
-  ) where
-
-import Data.Aeson
-import Data.Time.Calendar (Day)
-import GHC.Generics
-
-import Model.Income (IncomeId)
-import Model.User (UserId)
-import qualified Model.Income as M
-
-data Income = Income
-  { id :: IncomeId
-  , userId :: UserId
-  , date :: Day
-  , amount :: Int
-  } deriving (Show, Generic)
-
-instance ToJSON Income
-
-fromIncome :: M.Income -> Income
-fromIncome income = Income (M.id income) (M.userId income) (M.date income) (M.amount income)
diff --git a/src/server/Model/Json/Init.hs b/src/server/Model/Json/Init.hs
deleted file mode 100644
index 530c3b7..0000000
--- a/src/server/Model/Json/Init.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Init
-  ( Init(..)
-  , InitResult(..)
-  ) where
-
-import Data.Aeson
-import GHC.Generics
-
-import Model.Json.Category (Category)
-import Model.Json.Income (Income)
-import Model.Json.Payment (Payment)
-import Model.Json.PaymentCategory (PaymentCategory)
-import Model.Json.User (User)
-import Model.Message.Key (Key)
-import Model.User (UserId)
-
-data Init = Init
-  { users :: [User]
-  , me :: UserId
-  , payments :: [Payment]
-  , incomes :: [Income]
-  , categories :: [Category]
-  , paymentCategories :: [PaymentCategory]
-  } deriving (Show, Generic)
-
-instance ToJSON Init
-
-data InitResult =
-  InitEmpty
-  | InitSuccess Init
-  | InitError Key
-  deriving (Show, Generic)
-
-instance ToJSON InitResult
diff --git a/src/server/Model/Json/MessagePart.hs b/src/server/Model/Json/MessagePart.hs
deleted file mode 100644
index 0753d7c..0000000
--- a/src/server/Model/Json/MessagePart.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.MessagePart
-  ( MessagePart(..)
-  ) where
-
-import Data.Text (Text)
-
-import Data.Aeson
-import GHC.Generics
-
-data MessagePart =
-  Order Int
-  | Str Text
-  deriving (Eq, Show, Generic)
-
-instance FromJSON MessagePart
-instance ToJSON MessagePart
diff --git a/src/server/Model/Json/Number.hs b/src/server/Model/Json/Number.hs
deleted file mode 100644
index 52c9da8..0000000
--- a/src/server/Model/Json/Number.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Number
-  ( Number(..)
-  ) where
-
-import Data.Aeson
-import GHC.Generics
-
-data Number = Number
-  { number :: Int
-  } deriving (Show, Generic)
-
-instance FromJSON Number
-instance ToJSON Number
diff --git a/src/server/Model/Json/Payment.hs b/src/server/Model/Json/Payment.hs
deleted file mode 100644
index e406c0f..0000000
--- a/src/server/Model/Json/Payment.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Payment
-  ( Payment(..)
-  , fromPayment
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import Data.Time.Calendar (Day)
-import GHC.Generics
-import Prelude hiding (id)
-
-import Model.Frequency
-import Model.Payment (PaymentId)
-import Model.User (UserId)
-import qualified Model.Payment as M
-
-data Payment = Payment
-  { id :: PaymentId
-  , date :: Day
-  , name :: Text
-  , cost :: Int
-  , userId :: UserId
-  , frequency :: Frequency
-  } deriving (Show, Generic)
-
-instance FromJSON Payment
-instance ToJSON Payment
-
-fromPayment :: M.Payment -> Payment
-fromPayment payment =
-  Payment
-    { id = M.id payment
-    , date = M.date payment
-    , name = M.name payment
-    , cost = M.cost payment
-    , userId = M.userId payment
-    , frequency = M.frequency payment
-    }
diff --git a/src/server/Model/Json/PaymentCategory.hs b/src/server/Model/Json/PaymentCategory.hs
deleted file mode 100644
index fd97674..0000000
--- a/src/server/Model/Json/PaymentCategory.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.PaymentCategory
-  ( PaymentCategory(..)
-  , fromPaymentCategory
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import GHC.Generics
-
-import Model.Category (CategoryId)
-import qualified Model.PaymentCategory as M
-
-data PaymentCategory = PaymentCategory
-  { name :: Text
-  , category :: CategoryId
-  } deriving (Show, Generic)
-
-instance ToJSON PaymentCategory
-
-fromPaymentCategory :: M.PaymentCategory -> PaymentCategory
-fromPaymentCategory pc = PaymentCategory (M.name pc) (M.category pc)
diff --git a/src/server/Model/Json/Translation.hs b/src/server/Model/Json/Translation.hs
deleted file mode 100644
index 9dcfe80..0000000
--- a/src/server/Model/Json/Translation.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Translation
-  ( Translation(..)
-  ) where
-
-import GHC.Generics
-
-import Data.Aeson
-import Data.Text
-
-import Model.Json.MessagePart
-
-data Translation = Translation
-  { key :: Text
-  , message :: [MessagePart]
-  } deriving (Show, Generic)
-
-instance FromJSON Translation
-instance ToJSON Translation
diff --git a/src/server/Model/Json/User.hs b/src/server/Model/Json/User.hs
deleted file mode 100644
index c289fe0..0000000
--- a/src/server/Model/Json/User.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.User
-  ( User(..)
-  , fromUser
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import GHC.Generics
-
-import Model.User (UserId)
-import qualified Model.User as M
-
-data User = User
-  { id :: UserId
-  , name :: Text
-  , email :: Text
-  } deriving (Show, Generic)
-
-instance FromJSON User
-instance ToJSON User
-
-fromUser :: M.User -> User
-fromUser user = User (M.id user) (M.name user) (M.email user)
diff --git a/src/server/Model/Message.hs b/src/server/Model/Message.hs
deleted file mode 100644
index 026967f..0000000
--- a/src/server/Model/Message.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-module Model.Message
-  ( getMessage
-  , getParamMessage
-  , getTranslations
-  , plural
-  ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Model.Message.Key (Key)
-import Model.Message.Lang
-import Model.Message.Translations (getNonFormattedMessage)
-import Model.Message.Parts
-
-import Model.Json.Translation
-
-getMessage :: Key -> Text
-getMessage = getParamMessage []
-
-getParamMessage :: [Text] -> Key -> Text
-getParamMessage values paramKey = replaceParts values (getNonFormattedMessage lang paramKey)
-
-getTranslations :: [Translation]
-getTranslations = (map getTranslation [minBound..])
-
-getTranslation :: Key -> Translation
-getTranslation translationKey =
-  Translation
-    (T.pack . show $ translationKey)
-    (getParts $ getNonFormattedMessage lang translationKey)
-
-plural :: Int -> Key -> Key -> Text
-plural count singularKey pluralKey =
-  getParamMessage [T.pack . show $ count] (if count <= 1 then singularKey else pluralKey)
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
deleted file mode 100644
index 18f16f0..0000000
--- a/src/server/Model/Message/Key.hs
+++ /dev/null
@@ -1,193 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Message.Key
-  ( Key(..)
-  ) where
-
-import qualified Data.Aeson as Json
-import qualified Data.Text as T
-
-data Key =
-
-  -- Title
-
-  SharedCost
-
-  -- Sign
-
-  | Email
-  | SignIn
-  | SendEmailFail
-  | InvalidEmail
-  | UnauthorizedSignIn
-  | Forbidden
-  | EnterValidEmail
-  | SignInUsed
-  | SignInExpired
-  | SignInInvalid
-  | SignInMailTitle
-  | SignInMail
-  | SignInEmailSent
-
-  -- Dates
-
-  | January
-  | February
-  | March
-  | April
-  | May
-  | June
-  | July
-  | August
-  | September
-  | October
-  | November
-  | December
-
-  | ShortDate
-  | ShortMonthAndYear
-  | LongDate
-
-  -- Search
-
-  | SearchName
-  | SearchPunctual
-  | SearchMonthly
-
-  -- Payments
-
-  | PaymentsAreBalanced
-  | Name
-  | Cost
-  | Payer
-  | Date
-  | Frequency
-  | InvalidFrequency
-  | AddPayment
-  | ClonePayment
-  | EditPayment
-  | PaymentNotDeleted
-  | Punctual
-  | Monthly
-
-  | PaymentsTitle
-  | Payment
-  | Payments
-  | Worth
-  | NoPayment
-
-  | PaymentName
-  | PaymentCost
-  | PaymentDate
-  | PaymentCategory
-  | PaymentPunctual
-  | PaymentMonthly
-
-  | Clone
-  | Edit
-  | Delete
-  | ConfirmPaymentDelete
-
-  -- Categories
-
-  | Categories
-  | NoCategories
-  | CategoryNotDeleted
-  | AddCategory
-  | CloneCategory
-  | EditCategory
-  | ConfirmCategoryDelete
-  | CategoryName
-  | CategoryColor
-  | Color
-  | UsedCategory
-
-  -- Statistics
-
-  | Statistics
-  | ByMonthsAndMean
-  | By
-  | Total
-
-  -- Income
-
-  | CumulativeIncomesSince
-  | NoIncome
-  | Income
-  | MonthlyNetIncomes
-  | AddIncome
-  | CloneIncome
-  | EditIncome
-  | IncomeNotDeleted
-  | IncomeAmount
-  | IncomeDate
-  | ConfirmIncomeDelete
-  | Add
-
-  -- Form
-
-  | Empty
-  | InvalidString
-  | InvalidDate
-  | CostMustNotBeNull
-  | InvalidInt
-  | InvalidCategory
-  | InvalidColor
-  | AlreadyExists
-  | SmallerIntThan
-  | GreaterIntThan
-
-  -- Errors
-
-  | CreatePaymentError
-  | EditPaymentError
-  | DeletePaymentError
-  | CreateIncomeError
-  | EditIncomeError
-  | DeleteIncomeError
-  | CreateCategoryError
-  | EditCategoryError
-  | DeleteCategoryError
-  | SignOutError
-
-  -- Dialog
-
-  | Confirm
-  | Undo
-
-  -- Page not found
-
-  | PageNotFound
-
-  -- Weekly report
-
-  | WeeklyReport
-  | WeeklyReportEmpty
-  | PaymentCreated
-  | PaymentsCreated
-  | PaymentEdited
-  | PaymentsEdited
-  | PaymentDeleted
-  | PaymentsDeleted
-  | IncomeCreated
-  | IncomesCreated
-  | IncomeEdited
-  | IncomesEdited
-  | IncomeDeleted
-  | IncomesDeleted
-  | PayedFor
-  | DidNotPayFor
-  | IsPayedFrom
-  | IsNotPayedFrom
-
-  -- Http error
-
-  | BadUrl
-  | Timeout
-  | NetworkError
-  | BadPayload
-
-  deriving (Enum, Bounded, Show)
-
-instance Json.ToJSON Key where
-  toJSON = Json.String . T.pack . show
diff --git a/src/server/Model/Message/Lang.hs b/src/server/Model/Message/Lang.hs
deleted file mode 100644
index f515c96..0000000
--- a/src/server/Model/Message/Lang.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module Model.Message.Lang
-  ( Lang(..)
-  , lang
-  ) where
-
-data Lang =
-  English
-  | French
-
-lang :: Lang
-lang = French
diff --git a/src/server/Model/Message/Parts.hs b/src/server/Model/Message/Parts.hs
deleted file mode 100644
index d065cf2..0000000
--- a/src/server/Model/Message/Parts.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Model.Message.Parts
-  ( replaceParts
-  , getParts
-  ) where
-
-import Data.Maybe (listToMaybe, fromMaybe)
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Text.ParserCombinators.Parsec
-
-import Model.Json.MessagePart
-
-replaceParts :: [Text] -> Text -> Text
-replaceParts values message =
-  T.concat . map (replacePart values) $ getParts message
-
-replacePart :: [Text] -> MessagePart -> Text
-replacePart _ (Str str) = str
-replacePart values (Order n) =
-  fromMaybe (T.concat ["{", T.pack (show n), "}"]) . listToMaybe . drop (n - 1) $ values
-
-getParts :: Text -> [MessagePart]
-getParts str =
-  case parse partsParser "" (T.unpack str) of
-    Right parts -> parts
-    Left _ -> []
-
-partsParser :: Parser [MessagePart]
-partsParser = many partParser
-
-partParser :: Parser MessagePart
-partParser =
-  (do _ <- string "{"; n <- read <$> many1 digit; _ <- string "}"; return (Order n))
-  <|> (do str <- T.pack <$> many1 (noneOf "{"); return (Str str))
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
deleted file mode 100644
index 7d26c3f..0000000
--- a/src/server/Model/Message/Translations.hs
+++ /dev/null
@@ -1,729 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Model.Message.Translations
-  ( getNonFormattedMessage
-  ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Model.Message.Key
-import Model.Message.Lang
-
-getNonFormattedMessage :: Lang -> Key -> Text
-getNonFormattedMessage = m
-
-m :: Lang -> Key -> Text
-
--- Title
-
-m l SharedCost =
-  case l of
-    English -> "Shared Cost"
-    French  -> "Partage des frais"
-
--- Sign in
-
-m l Email =
-  case l of
-    English -> "Email"
-    French -> "Courriel"
-
-m l SignIn =
-  case l of
-    English -> "Sign in"
-    French  -> "Connexion"
-
-m l InvalidEmail =
-  case l of
-    English -> "Your email is not valid."
-    French  -> "Votre courriel n'est pas valide."
-
-m l UnauthorizedSignIn =
-  case l of
-    English -> "You are not authorized to sign in."
-    French  -> "Tu n'es pas autorisé à te connecter."
-
-m l Forbidden =
-  case l of
-    English -> "You need to be logged in to perform this action"
-    French  -> "Tu dois te connecter pour effectuer cette action"
-
-m l SendEmailFail =
-  case l of
-    English -> "You are authorized to sign in, but we failed to send you the sign up email."
-    French  -> "Tu es autorisé à te connecter, mais nous n'avons pas pu t'envoyer le courriel de connexion."
-
-m l EnterValidEmail =
-  case l of
-    English -> "Please enter a valid email address."
-    French  -> "Ton courriel n'est pas valide."
-
-m l SignInUsed =
-  case l of
-    English -> "You already used this link, please sign in again."
-    French  -> "Tu as déjà utilisé ce lien, connecte-toi à nouveau."
-
-m l SignInExpired =
-  case l of
-    English -> "The link expired, please sign in again."
-    French  -> "Le lien sur lequel tu as cliqué a expiré, connecte-toi à nouveau."
-
-m l SignInInvalid =
-  case l of
-    English -> "The link is invalid, please sign in again."
-    French  -> "Le lien sur lequel tu as cliqué est invalide, connecte-toi à nouveau."
-
-m l SignInMailTitle =
-  case l of
-    English -> T.concat ["Sign in to ", m l SharedCost]
-    French  -> T.concat ["Connexion à ", m l SharedCost]
-
-m l SignInMail =
-  T.intercalate
-    "\n"
-    ( case l of
-        English ->
-          [ "Hi {1},"
-          , ""
-          , T.concat
-              [ "Click to the following link in order to sign in to Shared Cost:"
-              , m l SharedCost
-              , ":"
-              ]
-          , "{2}"
-          , ""
-          , "See you soon!"
-          ]
-        French  ->
-          [ "Salut {1},"
-          , ""
-          , T.concat
-              [ "Clique sur le lien suivant pour te connecter à "
-              , m l SharedCost
-              , ":"
-              ]
-          , "{2}"
-          , ""
-          , "À très vite !"
-          ]
-    )
-
-m l SignInEmailSent =
-  case l of
-    English -> "We sent you an email with a connexion link."
-    French  -> "Nous t'avons envoyé un courriel avec un lien pour te connecter."
-
--- Date
-
-m l January =
-  case l of
-    English -> "january"
-    French  -> "janvier"
-
-m l February =
-  case l of
-    English -> "february"
-    French  -> "février"
-
-m l March =
-  case l of
-    English -> "march"
-    French  -> "mars"
-
-m l April =
-  case l of
-    English -> "april"
-    French  -> "avril"
-
-m l May =
-  case l of
-    English -> "may"
-    French  -> "mai"
-
-m l June =
-  case l of
-    English -> "june"
-    French  -> "juin"
-
-m l July =
-  case l of
-    English -> "july"
-    French  -> "juillet"
-
-m l August =
-  case l of
-    English -> "august"
-    French  -> "août"
-
-m l September =
-  case l of
-    English -> "september"
-    French  -> "septembre"
-
-m l October =
-  case l of
-    English -> "october"
-    French  -> "octobre"
-
-m l November =
-  case l of
-    English -> "november"
-    French  -> "novembre"
-
-m l December =
-  case l of
-    English -> "december"
-    French  -> "décembre"
-
-m l ShortDate =
-  case l of
-    English -> "{3}-{2}-{1}"
-    French  -> "{1}/{2}/{3}"
-
-m l ShortMonthAndYear =
-  case l of
-    English -> "{2}-{1}"
-    French  -> "{1}/{2}"
-
-m l LongDate =
-  case l of
-    English -> "{2} {1}, {3}"
-    French  -> "{1} {2} {3}"
-
--- Search
-
-m l SearchName =
-  case l of
-    English -> "Search"
-    French  -> "Recherche"
-
-m l SearchPunctual =
-  case l of
-    English -> "Punctual"
-    French  -> "Ponctuel"
-
-m l SearchMonthly =
-  case l of
-    English -> "Monthly"
-    French  -> "Mensuel"
-
--- Payments
-
-m l PaymentsAreBalanced =
-  case l of
-    English -> "Payments are balanced."
-    French  -> "Les paiements sont équilibrés."
-
-m l Name =
-  case l of
-    English -> "Name"
-    French  -> "Nom"
-
-m l Cost =
-  case l of
-    English -> "Cost"
-    French  -> "Coût"
-
-m l Payer =
-  case l of
-    English -> "Payer"
-    French  -> "Payeur"
-
-m l Date =
-  case l of
-    English -> "Date"
-    French  -> "Date"
-
-m l Frequency =
-  case l of
-    English -> "Frequency"
-    French  -> "Fréquence"
-
-m l InvalidFrequency =
-  case l of
-    English -> "Invalid frequency"
-    French  -> "Fréquence invalide"
-
-m l AddPayment =
-  case l of
-    English -> "Add a payment"
-    French  -> "Ajouter un paiement"
-
-m l ClonePayment =
-  case l of
-    English -> "Clone a payment"
-    French  -> "Cloner un paiement"
-
-m l EditPayment =
-  case l of
-    English -> "Edit a payment"
-    French  -> "Modifier un paiement"
-
-m l PaymentNotDeleted =
-  case l of
-    English -> "The payment could not have been deleted."
-    French  -> "Le paiement n'a pas pu être supprimé."
-
-m l Punctual =
-  case l of
-    English -> "Punctual"
-    French  -> "Ponctuelle"
-
-m l Monthly =
-  case l of
-    English -> "Monthly"
-    French  -> "Mensuelle"
-
-m l PaymentsTitle =
-  case l of
-    English -> "Payments"
-    French -> "Paiements"
-
-m l Payment =
-  case l of
-    English -> "payment"
-    French  -> "paiement"
-
-m l Payments =
-  case l of
-    English -> "payments"
-    French  -> "paiements"
-
-m l Worth =
-  case l of
-    English -> "{1} worth {2}"
-    French  -> "{1} comptabilisant {2}"
-
-m l NoPayment =
-  case l of
-    English -> "No payment found from your search criteria."
-    French  -> "Aucun paiement ne correspond à vos critères de recherches."
-
-m l PaymentName =
-  case l of
-    English -> "Name"
-    French  -> "Nom"
-
-m l PaymentCost =
-  case l of
-    English -> "Cost"
-    French  -> "Coût"
-
-m l PaymentDate =
-  case l of
-    English -> "Date"
-    French  -> "Date"
-
-m l PaymentCategory =
-  case l of
-    English -> "Category"
-    French  -> "Catégorie"
-
-m l PaymentPunctual =
-  case l of
-    English -> "Punctual"
-    French  -> "Ponctuel"
-
-m l PaymentMonthly =
-  case l of
-    English -> "Monthly"
-    French  -> "Mensuel"
-
-m l ConfirmPaymentDelete =
-  case l of
-    English -> "Are you sure to delete this payment ?"
-    French  -> "Voulez-vous vraiment supprimer ce paiement ?"
-
-m l Edit =
-  case l of
-    English -> "Edit"
-    French  -> "Modifier"
-
-m l Clone =
-  case l of
-    English -> "Clone"
-    French  -> "Cloner"
-
-m l Delete =
-  case l of
-    English -> "Delete"
-    French  -> "Supprimer"
-
--- Categories
-
-m l Categories =
-  case l of
-    English -> "Categories"
-    French  -> "Catégories"
-
-m l NoCategories =
-  case l of
-    English -> "No category."
-    French  -> "Aucune catégorie."
-
-m l CategoryNotDeleted =
-  case l of
-    English -> "The category could not have been deleted."
-    French  -> "La catégorie n'a pas pu être supprimé."
-
-m l AddCategory =
-  case l of
-    English -> "Add an category"
-    French  -> "Ajouter une catégorie"
-
-m l CloneCategory =
-  case l of
-    English -> "Clone an category"
-    French  -> "Cloner une catégorie"
-
-m l EditCategory =
-  case l of
-    English -> "Edit an category"
-    French  -> "Modifier une catégorie"
-
-m l ConfirmCategoryDelete =
-  case l of
-    English -> "Are you sure to delete this category ?"
-    French  -> "Voulez-vous vraiment supprimer cette catégorie ?"
-
-m l CategoryName =
-  case l of
-    English -> "Name"
-    French  -> "Nom"
-
-m l CategoryColor =
-  case l of
-    English -> "Color"
-    French  -> "Couleur"
-
-m l Color =
-  case l of
-    English -> "Color"
-    French  -> "Couleur"
-
-m l UsedCategory =
-  case l of
-    English -> "This category is currently being used"
-    French  -> "Cette catégorie est actuellement utilisée"
-
--- Statistics
-
-m l Statistics =
-  case l of
-    English -> "Statistics"
-    French  -> "Statistiques"
-
-m l ByMonthsAndMean =
-  case l of
-    English -> "Payments by category by month months ({1} on average)"
-    French  -> "Paiements par catégorie par mois (en moyenne {1})"
-
-m l By =
-  case l of
-    English -> "{1}: {2}"
-    French  -> "{1} : {2}"
-
-m l Total =
-  case l of
-    English -> "Total"
-    French  -> "Total"
-
--- Income
-
-m l CumulativeIncomesSince =
-  case l of
-    English -> "Cumulative incomes since {1}"
-    French  -> "Revenus nets cumulés depuis le {1}"
-
-m l NoIncome =
-  case l of
-    English -> "No income."
-    French  -> "Aucun revenu."
-
-m l Income =
-  case l of
-    English -> "Income"
-    French  -> "Revenu"
-
-m l MonthlyNetIncomes =
-  case l of
-    English -> "Net monthly incomes"
-    French  -> "Revenus mensuels nets"
-
-m l AddIncome =
-  case l of
-    English -> "Add an income"
-    French  -> "Ajouter un revenu"
-
-m l CloneIncome =
-  case l of
-    English -> "Clone an income"
-    French  -> "Cloner un revenu"
-
-m l EditIncome =
-  case l of
-    English -> "Edit an income"
-    French  -> "Modifier un revenu"
-
-m l IncomeNotDeleted =
-  case l of
-    English -> "The income could not have been deleted."
-    French  -> "Le revenu n'a pas pu être supprimé."
-
-m l IncomeAmount =
-  case l of
-    English -> "Amount"
-    French  -> "Montant"
-
-m l IncomeDate =
-  case l of
-    English -> "Date"
-    French  -> "Date"
-
-m l ConfirmIncomeDelete =
-  case l of
-    English -> "Are you sure to delete this income ?"
-    French  -> "Voulez-vous vraiment supprimer ce revenu ?"
-
-m l Add =
-  case l of
-    English -> "Add"
-    French  -> "Ajouter"
-
--- Form error
-
-m l Empty =
-  case l of
-    English -> "Required field"
-    French  -> "Champ requis"
-
-m l InvalidString =
-  case l of
-    English -> "String required"
-    French  -> "Chaîne de caractères requise"
-
-m l InvalidDate =
-  case l of
-    English -> "day/month/year required"
-    French  -> "jour/mois/année requis"
-
-m l CostMustNotBeNull =
-  case l of
-    English -> "Cost must not be zero"
-    French -> "Le coût ne doît pas être nul"
-
-m l InvalidInt =
-  case l of
-    English -> "Integer required"
-    French  -> "Entier requis"
-
-m l InvalidCategory =
-  case l of
-    English -> "Invalid category"
-    French  -> "Catégorie invalide"
-
-m l InvalidColor =
-  case l of
-    English -> "Invalid color"
-    French  -> "Couleur invalide"
-
-m l AlreadyExists =
-  case l of
-    English -> "Dupplicate field"
-    French  -> "Doublon"
-
-m l SmallerIntThan =
-  case l of
-    English -> "Integer bigger than {1} or equal required"
-    French  -> "Entier supérieur ou égal à {1} requis"
-
-m l GreaterIntThan =
-  case l of
-    English -> "Integer smaller than {1} or equal required"
-    French  -> "Entier inférieur ou égal à {1} requis"
-
--- Errors
-
-m l CreatePaymentError =
-  case l of
-    English -> "Error at payment creation"
-    French  -> "Erreur lors de la création du paiement"
-
-m l EditPaymentError =
-  case l of
-    English -> "Error at payment edition"
-    French  -> "Erreur lors de la modification du paiement"
-
-m l DeletePaymentError =
-  case l of
-    English -> "Error at payment deletion"
-    French  -> "Erreur lors de la suppression du paiement"
-
-m l CreateIncomeError =
-  case l of
-    English -> "Error at income creation"
-    French  -> "Erreur lors de la création du revenu"
-
-m l EditIncomeError =
-  case l of
-    English -> "Error at income edition"
-    French  -> "Erreur lors de la modification du revenu"
-
-m l DeleteIncomeError =
-  case l of
-    English -> "Error at income deletion"
-    French  -> "Erreur lors de la suppression du revenu"
-
-m l CreateCategoryError =
-  case l of
-    English -> "Error at category creation"
-    French  -> "Erreur lors de la création de la catégorie"
-
-m l EditCategoryError =
-  case l of
-    English -> "Error at category edition"
-    French  -> "Erreur lors de la modification de la catégorie"
-
-m l DeleteCategoryError =
-  case l of
-    English -> "Error at category deletion"
-    French  -> "Erreur lors de la suppression de la catégorie"
-
-m l SignOutError =
-  case l of
-    English -> "Error at sign out"
-    French  -> "Erreur lors de la déconnexion"
-
--- Dialog
-
-m l Confirm =
-  case l of
-    English -> "Confirm"
-    French  -> "Confirmer"
-
-m l Undo =
-  case l of
-    English -> "Undo"
-    French  -> "Annuler"
-
--- Page not found
-
-m l PageNotFound =
-  case l of
-    English -> "Page not found"
-    French  -> "Page introuvable"
-
--- Weekly report
-
-m l WeeklyReport =
-  case l of
-    English -> "Weekly report"
-    French  -> "Rapport hebdomadaire"
-
-m l WeeklyReportEmpty =
-  case l of
-    English -> "No activity the previous week."
-    French  -> "Pas d'activité la semaine passée."
-
-m l PaymentCreated =
-  case l of
-    English -> "{1} payment created:"
-    French  -> "{1} paiement créé :"
-
-m l PaymentsCreated =
-  case l of
-    English -> "{1} payments created:"
-    French  -> "{1} paiements créés :"
-
-m l PaymentEdited =
-  case l of
-    English -> "{1} payment edited:"
-    French  -> "{1} paiement modifié :"
-
-m l PaymentsEdited =
-  case l of
-    English -> "{1} payments edited:"
-    French  -> "{1} paiements modifiés :"
-
-m l PaymentDeleted =
-  case l of
-    English -> "{1} payment deleted:"
-    French  -> "{1} paiement supprimé :"
-
-m l PaymentsDeleted =
-  case l of
-    English -> "{1} payments deleted:"
-    French  -> "{1} paiements supprimés :"
-
-m l IncomeCreated =
-  case l of
-    English -> "{1} income created:"
-    French  -> "{1} revenu créé :"
-
-m l IncomesCreated =
-  case l of
-    English -> "{1} incomes created:"
-    French  -> "{1} revenus créés :"
-
-m l IncomeEdited =
-  case l of
-    English -> "{1} income edited:"
-    French  -> "{1} revenu modifié :"
-
-m l IncomesEdited =
-  case l of
-    English -> "{1} incomes edited:"
-    French  -> "{1} revenus modifiés :"
-
-m l IncomeDeleted =
-  case l of
-    English -> "{1} income deleted:"
-    French  -> "{1} revenu supprimé :"
-
-m l IncomesDeleted =
-  case l of
-    English -> "{1} incomes deleted:"
-    French  -> "{1} revenus supprimés :"
-
-m l PayedFor =
-  case l of
-    English -> "{1} payed {2} for “{3}” at {4}"
-    French  -> "{1} a payé {2} concernant « {3} » le {4}"
-
-m l DidNotPayFor =
-  case l of
-    English -> "{1} didn't pay {2} for “{3}” at {4}"
-    French  -> "{1} n'a pas payé {2} concernant « {3} » le {4}"
-
-m l IsPayedFrom =
-  case l of
-    English -> "{1} is payed {2} of net monthly income from {3}"
-    French  -> "{1} est payé {2} net par mois à partir du {3}"
-
-m l IsNotPayedFrom =
-  case l of
-    English -> "{1} isn't payed {2} of net monthly income from {3}"
-    French  -> "{1} n'est pas payé {2} net par mois à partir du {3}"
-
--- Http error
-
-m l BadUrl =
-  case l of
-    English -> "URL not valid"
-    French  -> "l'URL n'est pas valide"
-
-m l Timeout =
-  case l of
-    English -> "Timeout server error"
-    French  -> "Le serveur met trop de temps à répondre"
-
-m l NetworkError =
-  case l of
-    English -> "Network can not be reached"
-    French  -> "Le serveur n'est pas accessible"
-
-m l BadPayload =
-  case l of
-    English -> "Bad payload server error"
-    French  -> "Contenu inattendu en provenance du serveur"
diff --git a/src/server/Model/Payer.hs b/src/server/Model/Payer.hs
new file mode 100644
index 0000000..de4abd1
--- /dev/null
+++ b/src/server/Model/Payer.hs
@@ -0,0 +1,216 @@
+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 Common.Model (User(..), UserId, Income(..), IncomeId, Payment(..))
+
+type Users = Map UserId User
+
+type Payers = Map UserId Payer
+
+type Incomes = Map IncomeId Income
+
+type Payments = [Payment]
+
+data Payer = Payer
+  { preIncomePaymentSum :: Int
+  , postIncomePaymentSum :: Int
+  , _incomes :: [Income]
+  }
+
+data PostPaymentPayer = PostPaymentPayer
+  { _preIncomePaymentSum :: Int
+  , _cumulativeIncome :: Int
+  , ratio :: Float
+  }
+
+data ExceedingPayer = ExceedingPayer
+  { _userId :: UserId
+  , amount :: Int
+  } deriving (Show)
+
+getOrderedExceedingPayers :: UTCTime -> [User] -> [Income] -> Payments -> [ExceedingPayer]
+getOrderedExceedingPayers currentTime users incomes payments =
+  let usersMap = Map.fromList . map (\user -> (_user_id user, user)) $ users
+      incomesMap = Map.fromList . map (\income -> (_income_id income, income)) $ incomes
+      payers = getPayers currentTime usersMap incomesMap payments
+      exceedingPayersOnPreIncome =
+        exceedingPayersFromAmounts
+          . Map.toList
+          . Map.map preIncomePaymentSum
+          $ payers
+      mbSince = useIncomesFrom usersMap incomesMap payments
+  in  case mbSince of
+        Just since ->
+          let postPaymentPayers = Map.map (getPostPaymentPayer currentTime since) payers
+              mbMaxRatio =
+                safeMaximum
+                  . map (ratio . snd)
+                  . Map.toList
+                  $ postPaymentPayers
+          in  case mbMaxRatio of
+                Just maxRatio ->
+                  exceedingPayersFromAmounts
+                    . Map.toList
+                    . Map.map (getFinalDiff maxRatio)
+                    $ postPaymentPayers
+                Nothing ->
+                  exceedingPayersOnPreIncome
+        _ ->
+          exceedingPayersOnPreIncome
+
+useIncomesFrom :: Users -> Incomes -> Payments -> Maybe UTCTime
+useIncomesFrom users incomes payments =
+  let firstPaymentTime = safeHead . List.sort . map paymentTime $ payments
+      mbIncomeTime = incomeDefinedForAll (Map.keys users) incomes
+  in  case (firstPaymentTime, mbIncomeTime) of
+        (Just t1, Just t2) -> Just (max t1 t2)
+        _ -> Nothing
+
+paymentTime :: Payment -> UTCTime
+paymentTime = flip UTCTime (Time.secondsToDiffTime 0) . _payment_date
+
+getPayers :: UTCTime -> Users -> Incomes -> Payments -> Payers
+getPayers currentTime users incomes payments =
+  let userIds = Map.keys users
+      incomesDefined = incomeDefinedForAll userIds incomes
+  in  Map.fromList
+        . map (\userId ->
+            ( userId
+            , Payer
+                { preIncomePaymentSum =
+                    totalPayments
+                      (\p -> paymentTime p < (Maybe.fromMaybe currentTime incomesDefined))
+                      userId
+                      payments
+                , postIncomePaymentSum =
+                    totalPayments
+                      (\p ->
+                        case incomesDefined of
+                          Nothing -> False
+                          Just t -> paymentTime p >= t
+                      )
+                      userId
+                      payments
+                , _incomes = filter ((==) userId . _income_userId) (Map.elems incomes)
+                }
+            )
+        )
+        $ userIds
+
+exceedingPayersFromAmounts :: [(UserId, Int)] -> [ExceedingPayer]
+exceedingPayersFromAmounts userAmounts =
+  case mbMinAmount of
+    Nothing ->
+      []
+    Just minAmount ->
+      filter (\payer -> amount payer > 0)
+        . map (\userAmount ->
+           ExceedingPayer
+             { _userId = fst userAmount
+             , amount = snd userAmount - minAmount
+             }
+        )
+        $ userAmounts
+  where mbMinAmount = safeMinimum . map snd $ userAmounts
+
+getPostPaymentPayer :: UTCTime -> UTCTime -> Payer -> PostPaymentPayer
+getPostPaymentPayer currentTime since payer =
+  PostPaymentPayer
+    { _preIncomePaymentSum = preIncomePaymentSum payer
+    , _cumulativeIncome = cumulativeIncome
+    , ratio = (fromIntegral . postIncomePaymentSum $ payer) / (fromIntegral cumulativeIncome)
+    }
+  where cumulativeIncome = cumulativeIncomesSince currentTime since (_incomes payer)
+
+getFinalDiff :: Float -> PostPaymentPayer -> Int
+getFinalDiff maxRatio payer =
+  let postIncomeDiff =
+        truncate $ -1.0 * (maxRatio - ratio payer) * (fromIntegral . _cumulativeIncome $ payer)
+  in  postIncomeDiff + _preIncomePaymentSum payer
+
+incomeDefinedForAll :: [UserId] -> Incomes -> Maybe UTCTime
+incomeDefinedForAll userIds incomes =
+  let userIncomes = map (\userId -> filter ((==) userId . _income_userId) . Map.elems $ incomes) userIds
+      firstIncomes = map (safeHead . List.sortOn incomeTime) userIncomes
+  in  if all Maybe.isJust firstIncomes
+        then safeHead . reverse . List.sort . map incomeTime . Maybe.catMaybes $ firstIncomes
+        else Nothing
+
+cumulativeIncomesSince :: UTCTime -> UTCTime -> [Income] -> Int
+cumulativeIncomesSince currentTime since incomes =
+  getCumulativeIncome currentTime (getOrderedIncomesSince since incomes)
+
+getOrderedIncomesSince :: UTCTime -> [Income] -> [Income]
+getOrderedIncomesSince time incomes =
+  let mbStarterIncome = getIncomeAt time incomes
+      orderedIncomesSince = filter (\income -> incomeTime income >= time) incomes
+  in  (Maybe.maybeToList mbStarterIncome) ++ orderedIncomesSince
+
+getIncomeAt :: UTCTime -> [Income] -> Maybe Income
+getIncomeAt time incomes =
+  case incomes of
+    [x] ->
+      if incomeTime x < time
+        then Just $ x { _income_date = utctDay time }
+        else Nothing
+    x1 : x2 : xs ->
+      if incomeTime x1 < time && incomeTime x2 >= time
+        then Just $ x1 { _income_date = utctDay time }
+        else getIncomeAt time (x2 : xs)
+    [] ->
+      Nothing
+
+getCumulativeIncome :: UTCTime -> [Income] -> Int
+getCumulativeIncome currentTime incomes =
+  sum
+    . map durationIncome
+    . getIncomesWithDuration currentTime
+    . List.sortOn incomeTime
+    $ incomes
+
+getIncomesWithDuration :: UTCTime -> [Income] -> [(NominalDiffTime, Int)]
+getIncomesWithDuration currentTime incomes =
+  case incomes of
+    [] ->
+      []
+    [income] ->
+      [(Time.diffUTCTime currentTime (incomeTime income), _income_amount income)]
+    (income1 : income2 : xs) ->
+      (Time.diffUTCTime (incomeTime income2) (incomeTime income1), _income_amount income1) : (getIncomesWithDuration currentTime (income2 : xs))
+
+incomeTime :: Income -> UTCTime
+incomeTime = flip UTCTime (Time.secondsToDiffTime 0) . _income_date
+
+durationIncome :: (NominalDiffTime, Int) -> Int
+durationIncome (duration, income) =
+  truncate $ duration * fromIntegral income / (nominalDay * 365 / 12)
+
+nominalDay :: NominalDiffTime
+nominalDay = 86400
+
+safeHead :: [a] -> Maybe a
+safeHead [] = Nothing
+safeHead (x : _) = Just x
+
+safeMinimum :: (Ord a) => [a] -> Maybe a
+safeMinimum [] = Nothing
+safeMinimum xs = Just . minimum $ xs
+
+safeMaximum :: (Ord a) => [a] -> Maybe a
+safeMaximum [] = Nothing
+safeMaximum xs = Just . maximum $ xs
+
+totalPayments :: (Payment -> Bool) -> UserId -> Payments -> Int
+totalPayments paymentFilter userId payments =
+  sum
+    . map _payment_cost
+    . filter (\payment -> paymentFilter payment && _payment_user payment == userId)
+    $ payments
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 5414d18..5b576c5 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Model.Payment
-  ( PaymentId
-  , Payment(..)
+  ( Payment(..)
   , find
   , list
   , listMonthly
@@ -13,7 +13,6 @@ module Model.Payment
   , modifiedDuring
   ) where
 
-import Data.Int (Int64)
 import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import Data.Time (UTCTime)
@@ -24,29 +23,19 @@ import Database.SQLite.Simple.ToField (ToField(toField))
 import Prelude hiding (id)
 import qualified Database.SQLite.Simple as SQLite
 
-import Model.Frequency
+import Common.Model.Frequency
+import Common.Model.Payment (Payment(..))
+import Common.Model.User (UserId)
+import Common.Model.Payment (PaymentId)
+
+import Model.Frequency ()
 import Model.Query (Query(Query))
-import Model.User (UserId)
 import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
 
-type PaymentId = Int64
-
-data Payment = Payment
-  { id :: PaymentId
-  , userId :: UserId
-  , name :: Text
-  , cost :: Int
-  , date :: Day
-  , frequency :: Frequency
-  , createdAt :: UTCTime
-  , editedAt :: Maybe UTCTime
-  , deletedAt :: Maybe UTCTime
-  } deriving Show
-
 instance Resource Payment where
-  resourceCreatedAt = createdAt
-  resourceEditedAt = editedAt
-  resourceDeletedAt = deletedAt
+  resourceCreatedAt = _payment_createdAt
+  resourceEditedAt = _payment_editedAt
+  resourceDeletedAt = _payment_deletedAt
 
 instance FromRow Payment where
   fromRow = Payment <$>
@@ -62,12 +51,12 @@ instance FromRow Payment where
 
 instance ToRow Payment where
   toRow p =
-    [ toField (userId p)
-    , toField (name p)
-    , toField (cost p)
-    , toField (date p)
-    , toField (frequency p)
-    , toField (createdAt p)
+    [ toField (_payment_user p)
+    , toField (_payment_name p)
+    , toField (_payment_cost p)
+    , toField (_payment_date p)
+    , toField (_payment_frequency p)
+    , toField (_payment_createdAt p)
     ]
 
 find :: PaymentId -> Query (Maybe Payment)
@@ -92,13 +81,13 @@ listMonthly =
   )
 
 create :: UserId -> Text -> Int -> Day -> Frequency -> Query PaymentId
-create paymentUserId paymentName paymentCost paymentDate paymentFrequency =
+create userId paymentName paymentCost paymentDate paymentFrequency =
   Query (\conn -> do
     now <- getCurrentTime
     SQLite.execute
       conn
       "INSERT INTO payment (user_id, name, cost, date, frequency, created_at) VALUES (?, ?, ?, ?, ?, ?)"
-      (paymentUserId, paymentName, paymentCost, paymentDate, paymentFrequency, now)
+      (userId, paymentName, paymentCost, paymentDate, paymentFrequency, now)
     SQLite.lastInsertRowId conn
   )
 
@@ -112,13 +101,13 @@ createMany payments =
   )
 
 editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
-editOwn paymentUserId paymentId paymentName paymentCost paymentDate paymentFrequency =
+editOwn userId paymentId paymentName paymentCost paymentDate paymentFrequency =
   Query (\conn -> do
     mbPayment <- listToMaybe <$>
       SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
     case mbPayment of
       Just payment ->
-        if userId payment == paymentUserId
+        if _payment_user payment == userId
           then do
             now <- getCurrentTime
             SQLite.execute
@@ -133,13 +122,13 @@ editOwn paymentUserId paymentId paymentName paymentCost paymentDate paymentFrequ
   )
 
 deleteOwn :: UserId -> PaymentId -> Query Bool
-deleteOwn paymentUserId paymentId =
+deleteOwn userId paymentId =
   Query (\conn -> do
     mbPayment <- listToMaybe <$>
       SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
     case mbPayment of
       Just payment ->
-        if userId payment == paymentUserId
+        if _payment_user payment == userId
           then do
             now <- getCurrentTime
             SQLite.execute
diff --git a/src/server/Model/PaymentCategory.hs b/src/server/Model/PaymentCategory.hs
index 7c504dc..6e1d304 100644
--- a/src/server/Model/PaymentCategory.hs
+++ b/src/server/Model/PaymentCategory.hs
@@ -1,35 +1,23 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Model.PaymentCategory
-  ( PaymentCategoryId
-  , PaymentCategory(..)
-  , list
+  ( list
   , listByCategory
   , save
   ) where
 
-import Data.Int (Int64)
 import Data.Maybe (isJust, listToMaybe)
 import Data.Text (Text)
-import Data.Time (UTCTime)
 import Data.Time.Clock (getCurrentTime)
 import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
 import qualified Data.Text as T
 import qualified Database.SQLite.Simple as SQLite
 
-import Model.Category (CategoryId)
-import Model.Query (Query(Query))
-import qualified Utils.Text as T
-
-type PaymentCategoryId = Int64
+import Common.Model (CategoryId, PaymentCategory(..))
+import qualified Common.Util.Text as T
 
-data PaymentCategory = PaymentCategory
-  { id :: PaymentCategoryId
-  , name :: Text
-  , category :: CategoryId
-  , createdAt :: UTCTime
-  , editedAt :: Maybe UTCTime
-  } deriving Show
+import Model.Query (Query(Query))
 
 instance FromRow PaymentCategory where
   fromRow = PaymentCategory <$>
diff --git a/src/server/Model/User.hs b/src/server/Model/User.hs
index c8a0d53..eb78a69 100644
--- a/src/server/Model/User.hs
+++ b/src/server/Model/User.hs
@@ -1,35 +1,23 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Model.User
-  ( UserId
-  , User(..)
-  , list
-  , getUser
-  , findUser
+  ( list
+  , get
   , createUser
   , deleteUser
   ) where
 
-import Data.Int (Int64)
-import Data.List (find)
 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 Prelude hiding (id)
 import qualified Database.SQLite.Simple as SQLite
 
-import Model.Query (Query(Query))
-
-type UserId = Int64
+import Common.Model (UserId, User(..))
 
-data User = User
-  { id :: UserId
-  , creation :: UTCTime
-  , email :: Text
-  , name :: Text
-  } deriving Show
+import Model.Query (Query(Query))
 
 instance FromRow User where
   fromRow = User <$> SQLite.field <*> SQLite.field <*> SQLite.field <*> SQLite.field
@@ -37,15 +25,12 @@ instance FromRow User where
 list :: Query [User]
 list = Query (\conn -> SQLite.query_ conn "SELECT * from user ORDER BY creation DESC")
 
-getUser :: Text -> Query (Maybe User)
-getUser userEmail =
+get :: Text -> Query (Maybe User)
+get userEmail =
   Query (\conn -> listToMaybe <$>
     SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail)
   )
 
-findUser :: UserId -> [User] -> Maybe User
-findUser userId = find ((==) userId . id)
-
 createUser :: Text -> Text -> Query UserId
 createUser userEmail userName =
   Query (\conn -> do
-- 
cgit v1.2.3