Use a better project structure

12 files changed, 0 insertions, 850 deletions

diff --git a/src/server/Model/Category.hs b/src/server/Model/Category.hs
deleted file mode 100644
index 6b7a488..0000000
--- a/src/server/Model/Category.hs
+++ /dev/null
@@ -1,79 +0,0 @@
-{-# LANGUAGE OverloadedStrings    #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Model.Category
-  ( list
-  , create
-  , edit
-  , 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 qualified Database.SQLite.Simple as SQLite
-import Prelude hiding (id)
-
-import Common.Model (Category(..), CategoryId)
-
-import Model.Query (Query(Query))
-
-instance FromRow Category where
-  fromRow = Category <$>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field
-
-list :: Query [Category]
-list =
-  Query (\conn ->
-    SQLite.query_ conn "SELECT * FROM category WHERE deleted_at IS NULL"
-  )
-
-create :: Text -> Text -> Query CategoryId
-create categoryName categoryColor =
-  Query (\conn -> do
-    now <- getCurrentTime
-    SQLite.execute
-      conn
-      "INSERT INTO category (name, color, created_at) VALUES (?, ?, ?)"
-      (categoryName, categoryColor, now)
-    SQLite.lastInsertRowId conn
-  )
-
-edit :: CategoryId -> Text -> Text -> Query Bool
-edit categoryId categoryName categoryColor =
-  Query (\conn -> do
-    mbCategory <- listToMaybe <$>
-      (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId) :: IO [Category])
-    if isJust mbCategory
-      then do
-        now <- getCurrentTime
-        SQLite.execute
-          conn
-          "UPDATE category SET edited_at = ?, name = ?, color = ? WHERE id = ?"
-          (now, categoryName, categoryColor, categoryId)
-        return True
-      else
-        return False
-  )
-
-delete :: CategoryId -> Query Bool
-delete categoryId =
-  Query (\conn -> do
-    mbCategory <- listToMaybe <$>
-      (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId) :: IO [Category])
-    if isJust mbCategory
-      then do
-        now <- getCurrentTime
-        SQLite.execute
-          conn
-          "UPDATE category SET deleted_at = ? WHERE id = ?" (now, categoryId)
-        return True
-      else
-        return False
-  )
diff --git a/src/server/Model/Frequency.hs b/src/server/Model/Frequency.hs
deleted file mode 100644
index 4f7b83d..0000000
--- a/src/server/Model/Frequency.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-{-# 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 Common.Model.Frequency (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"]
-
-instance ToField Frequency where
-  toField frequency = SQLText . T.pack . show $ frequency
diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
deleted file mode 100644
index bbe7657..0000000
--- a/src/server/Model/Income.hs
+++ /dev/null
@@ -1,97 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Model.Income
-  ( list
-  , create
-  , editOwn
-  , deleteOwn
-  , 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 qualified Database.SQLite.Simple as SQLite
-
-import Common.Model (Income(..), IncomeId, User(..), UserId)
-
-import Model.Query (Query(Query))
-import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
-
-instance Resource Income where
-  resourceCreatedAt = _income_createdAt
-  resourceEditedAt = _income_editedAt
-  resourceDeletedAt = _income_deletedAt
-
-instance FromRow Income where
-  fromRow = Income <$>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field
-
-list :: Query [Income]
-list = Query (\conn -> SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL")
-
-create :: UserId -> Day -> Int -> Query IncomeId
-create incomeUserId incomeDate incomeAmount =
-  Query (\conn -> do
-    now <- getCurrentTime
-    SQLite.execute
-      conn
-      "INSERT INTO income (user_id, date, amount, created_at) VALUES (?, ?, ?, ?)"
-      (incomeUserId, incomeDate, incomeAmount, now)
-    SQLite.lastInsertRowId conn
-  )
-
-editOwn :: UserId -> IncomeId -> Day -> Int -> Query Bool
-editOwn incomeUserId incomeId incomeDate incomeAmount =
-  Query (\conn -> do
-    mbIncome <- listToMaybe <$> SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
-    case mbIncome of
-      Just income ->
-        if _income_userId income == incomeUserId
-          then do
-            now <- getCurrentTime
-            SQLite.execute
-              conn
-              "UPDATE income SET edited_at = ?, date = ?, amount = ? WHERE id = ?"
-              (now, incomeDate, incomeAmount, incomeId)
-            return True
-          else
-            return False
-      Nothing ->
-        return False
-  )
-
-deleteOwn :: User -> IncomeId -> Query Bool
-deleteOwn user incomeId =
-  Query (\conn -> do
-    mbIncome <- listToMaybe <$> SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
-    case mbIncome of
-      Just income ->
-        if _income_userId income == _user_id user
-          then do
-            now <- getCurrentTime
-            SQLite.execute conn "UPDATE income SET deleted_at = ? WHERE id = ?" (now, incomeId)
-            return True
-          else
-            return False
-      Nothing ->
-        return False
-  )
-
-modifiedDuring :: UTCTime -> UTCTime -> Query [Income]
-modifiedDuring start end =
-  Query (\conn ->
-    SQLite.query
-      conn
-      "SELECT * FROM income WHERE (created_at >= ? AND created_at <= ?) OR (edited_at >= ? AND edited_at <= ?) OR (deleted_at >= ? AND deleted_at <= ?)"
-      (start, end, start, end, start, end)
-  )
diff --git a/src/server/Model/Init.hs b/src/server/Model/Init.hs
deleted file mode 100644
index 8c6a961..0000000
--- a/src/server/Model/Init.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Model.Init
-  ( getInit
-  ) where
-
-import Common.Model (Init(Init), User(..))
-
-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.PaymentCategory as PaymentCategory
-import qualified Model.User as User
-
-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/Mail.hs b/src/server/Model/Mail.hs
deleted file mode 100644
index 9a4db73..0000000
--- a/src/server/Model/Mail.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Model.Mail
-  ( Mail(..)
-  ) where
-
-import Data.Text (Text)
-
-data Mail = Mail
-  { from :: Text
-  , to :: [Text]
-  , subject :: Text
-  , plainBody :: Text
-  } deriving (Eq, Show)
diff --git a/src/server/Model/Payer.hs b/src/server/Model/Payer.hs
deleted file mode 100644
index de4abd1..0000000
--- a/src/server/Model/Payer.hs
+++ /dev/null
@@ -1,216 +0,0 @@
-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
deleted file mode 100644
index 3893850..0000000
--- a/src/server/Model/Payment.hs
+++ /dev/null
@@ -1,178 +0,0 @@
-{-# LANGUAGE OverloadedStrings    #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Model.Payment
-  ( Payment(..)
-  , find
-  , list
-  , listMonthly
-  , create
-  , createMany
-  , editOwn
-  , deleteOwn
-  , 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 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 Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
-
-instance Resource Payment where
-  resourceCreatedAt = _payment_createdAt
-  resourceEditedAt = _payment_editedAt
-  resourceDeletedAt = _payment_deletedAt
-
-instance FromRow Payment where
-  fromRow = Payment <$>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field
-
-instance ToRow Payment where
-  toRow 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)
-find paymentId =
-  Query (\conn -> listToMaybe <$>
-    SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
-  )
-
-list :: Query [Payment]
-list =
-  Query (\conn ->
-    SQLite.query_ conn "SELECT * FROM payment WHERE deleted_at IS NULL"
-  )
-
-listMonthly :: Query [Payment]
-listMonthly =
-  Query (\conn ->
-    SQLite.query
-      conn
-      (SQLite.Query $ T.intercalate " "
-        [ "SELECT *"
-        , "FROM payment"
-        , "WHERE deleted_at IS NULL AND frequency = ?"
-        , "ORDER BY name DESC"
-        ])
-      (Only Monthly)
-  )
-
-create :: UserId -> Text -> Int -> Day -> Frequency -> Query PaymentId
-create userId paymentName paymentCost paymentDate paymentFrequency =
-  Query (\conn -> do
-    now <- getCurrentTime
-    SQLite.execute
-      conn
-      (SQLite.Query $ T.intercalate " "
-        [ "INSERT INTO payment (user_id, name, cost, date, frequency, created_at)"
-        , "VALUES (?, ?, ?, ?, ?, ?)"
-        ])
-      (userId, paymentName, paymentCost, paymentDate, paymentFrequency, now)
-    SQLite.lastInsertRowId conn
-  )
-
-createMany :: [Payment] -> Query ()
-createMany payments =
-  Query (\conn ->
-    SQLite.executeMany
-      conn
-      (SQLite.Query $ T.intercalate ""
-        [ "INSERT INTO payment (user_id, name, cost, date, frequency, created_at)"
-        , "VALUES (?, ?, ?, ?, ?, ?)"
-        ])
-      payments
-  )
-
-editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
-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 _payment_user payment == userId
-          then do
-            now <- getCurrentTime
-            SQLite.execute
-              conn
-              (SQLite.Query $ T.intercalate " "
-                [ "UPDATE payment"
-                , "SET edited_at = ?,"
-                , "    name = ?,"
-                , "    cost = ?,"
-                , "    date = ?,"
-                , "    frequency = ?"
-                , "WHERE id = ?"
-                ])
-              (now, paymentName, paymentCost, paymentDate, paymentFrequency, paymentId)
-            return True
-          else
-            return False
-      Nothing ->
-        return False
-  )
-
-deleteOwn :: UserId -> PaymentId -> Query Bool
-deleteOwn userId paymentId =
-  Query (\conn -> do
-    mbPayment <- listToMaybe <$>
-      SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
-    case mbPayment of
-      Just payment ->
-        if _payment_user payment == userId
-          then do
-            now <- getCurrentTime
-            SQLite.execute
-              conn
-              "UPDATE payment SET deleted_at = ? WHERE id = ?"
-              (now, paymentId)
-            return True
-          else
-            return False
-      Nothing ->
-        return False
-  )
-
-modifiedDuring :: UTCTime -> UTCTime -> Query [Payment]
-modifiedDuring start end =
-  Query (\conn ->
-    SQLite.query
-      conn
-      (SQLite.Query $ T.intercalate " "
-        [ "SELECT *"
-        , "FROM payment"
-        , "WHERE (created_at >= ? AND created_at <= ?)"
-        , "   OR (edited_at >= ?  AND edited_at <= ?)"
-        , "   OR (deleted_at >= ? AND deleted_at <= ?)"
-        ])
-      (start, end, start, end, start, end)
-  )
diff --git a/src/server/Model/PaymentCategory.hs b/src/server/Model/PaymentCategory.hs
deleted file mode 100644
index 6e1d304..0000000
--- a/src/server/Model/PaymentCategory.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-{-# LANGUAGE OverloadedStrings    #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Model.PaymentCategory
-  ( list
-  , listByCategory
-  , 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 qualified Database.SQLite.Simple as SQLite
-
-import Common.Model (CategoryId, PaymentCategory(..))
-import qualified Common.Util.Text as T
-
-import Model.Query (Query(Query))
-
-instance FromRow PaymentCategory where
-  fromRow = PaymentCategory <$>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field
-
-list :: Query [PaymentCategory]
-list = Query (\conn -> SQLite.query_ conn "SELECT * from payment_category")
-
-listByCategory :: CategoryId -> Query [PaymentCategory]
-listByCategory cat =
-  Query (\conn ->
-    SQLite.query conn "SELECT * FROM payment_category WHERE category = ?" (Only cat)
-  )
-
-save :: Text -> CategoryId -> Query ()
-save newName categoryId =
-  Query (\conn -> do
-    now <- getCurrentTime
-    mbPaymentCategory <- listToMaybe <$>
-      (SQLite.query
-        conn
-        "SELECT * FROM payment_category WHERE name = ?"
-        (Only (formatPaymentName newName)) :: IO [PaymentCategory])
-    if isJust mbPaymentCategory
-      then
-        SQLite.execute
-          conn
-          "UPDATE payment_category SET category = ?, edited_at = ? WHERE name = ?"
-          (categoryId, now, formatPaymentName newName)
-      else do
-        SQLite.execute
-          conn
-          "INSERT INTO payment_category (name, category, created_at) VALUES (?, ?, ?)"
-          (formatPaymentName newName, categoryId, now)
-  )
-  where
-    formatPaymentName :: Text -> Text
-    formatPaymentName = T.unaccent . T.toLower
diff --git a/src/server/Model/Query.hs b/src/server/Model/Query.hs
deleted file mode 100644
index d15fb5f..0000000
--- a/src/server/Model/Query.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-module Model.Query
-  ( Query(..)
-  , run
-  ) where
-
-import Data.Functor (Functor)
-import Database.SQLite.Simple (Connection)
-import qualified Database.SQLite.Simple as SQLite
-
-data Query a = Query (Connection -> IO a)
-
-instance Functor Query where
-  fmap f (Query call) = Query (fmap f . call)
-
-instance Applicative Query where
-  pure x = Query (const $ return x)
-  (Query callF) <*> (Query callX) = Query (\conn -> do
-    x <- callX conn
-    f <- callF conn
-    return (f x))
-
-instance Monad Query where
-  (Query callX) >>= f = Query (\conn -> do
-    x <- callX conn
-    case f x of Query callY -> callY conn)
-
-run :: Query a -> IO a
-run (Query call) = do
-  conn <- SQLite.open "database"
-  result <- call conn
-  _ <- SQLite.close conn
-  return result
diff --git a/src/server/Model/SignIn.hs b/src/server/Model/SignIn.hs
deleted file mode 100644
index c5182f0..0000000
--- a/src/server/Model/SignIn.hs
+++ /dev/null
@@ -1,66 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Model.SignIn
-  ( SignIn(..)
-  , createSignInToken
-  , getSignIn
-  , signInTokenToUsed
-  , 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 qualified Database.SQLite.Simple as SQLite
-
-import Model.Query (Query(Query))
-import Model.UUID (generateUUID)
-
-type SignInId = Int64
-
-data SignIn = SignIn
-  { id :: SignInId
-  , token :: Text
-  , creation :: UTCTime
-  , email :: Text
-  , isUsed :: Bool
-  } deriving Show
-
-instance FromRow SignIn where
-  fromRow = SignIn <$>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field
-
-createSignInToken :: Text -> Query Text
-createSignInToken signInEmail =
-  Query (\conn -> do
-    now <- getCurrentTime
-    signInToken <- generateUUID
-    SQLite.execute conn "INSERT INTO sign_in (token, creation, email, is_used) VALUES (?, ?, ?, ?)" (signInToken, now, signInEmail, False)
-    return signInToken
-  )
-
-getSignIn :: Text -> Query (Maybe SignIn)
-getSignIn signInToken =
-  Query (\conn -> do
-    listToMaybe <$> (SQLite.query conn "SELECT * from sign_in WHERE token = ? LIMIT 1" (Only signInToken) :: IO [SignIn])
-  )
-
-signInTokenToUsed :: SignInId -> Query ()
-signInTokenToUsed tokenId =
-  Query (\conn ->
-    SQLite.execute conn "UPDATE sign_in SET is_used = ? WHERE id = ?" (True, tokenId)
-  )
-
-isLastTokenValid :: SignIn -> Query Bool
-isLastTokenValid signIn =
-  Query (\conn -> do
-    [ Only lastToken ] <- SQLite.query conn "SELECT token from sign_in WHERE email = ? AND is_used = ? ORDER BY creation DESC LIMIT 1" (email signIn, True)
-    return . maybe False (== (token signIn)) $ lastToken
-  )
diff --git a/src/server/Model/UUID.hs b/src/server/Model/UUID.hs
deleted file mode 100644
index 6cb7ce0..0000000
--- a/src/server/Model/UUID.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module Model.UUID
-  ( generateUUID
-  ) where
-
-import Data.UUID (toString)
-import Data.UUID.V4 (nextRandom)
-import Data.Text (Text, pack)
-
-generateUUID :: IO Text
-generateUUID = pack . toString <$> nextRandom
diff --git a/src/server/Model/User.hs b/src/server/Model/User.hs
deleted file mode 100644
index e14fcef..0000000
--- a/src/server/Model/User.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# LANGUAGE OverloadedStrings    #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Model.User
-  ( list
-  , get
-  , create
-  , 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 qualified Database.SQLite.Simple as SQLite
-
-import Common.Model (UserId, User(..))
-
-import Model.Query (Query(Query))
-
-instance FromRow User where
-  fromRow = User <$> SQLite.field <*> SQLite.field <*> SQLite.field <*> SQLite.field
-
-list :: Query [User]
-list = Query (\conn -> SQLite.query_ conn "SELECT * from user ORDER BY creation DESC")
-
-get :: Text -> Query (Maybe User)
-get userEmail =
-  Query (\conn -> listToMaybe <$>
-    SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail)
-  )
-
-create :: Text -> Text -> Query UserId
-create userEmail userName =
-  Query (\conn -> do
-    now <- getCurrentTime
-    SQLite.execute
-      conn
-      "INSERT INTO user (creation, email, name) VALUES (?, ?, ?)"
-      (now, userEmail, userName)
-    SQLite.lastInsertRowId conn
-  )
-
-delete :: Text -> Query ()
-delete userEmail =
-  Query (\conn ->
-    SQLite.execute conn "DELETE FROM user WHERE email = ?" (Only userEmail)
-  )