Replace persistent by sqlite-simple

20 files changed, 600 insertions, 434 deletions

diff --git a/src/server/Model/Category.hs b/src/server/Model/Category.hs
index 50c3622..9597bd9 100644
--- a/src/server/Model/Category.hs
+++ b/src/server/Model/Category.hs
@@ -1,56 +1,90 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.Category
-  ( list
+  ( CategoryId
+  , Category(..)
+  , list
   , create
   , edit
   , delete
   ) where
 
+import Data.Int (Int64)
+import Data.Maybe (isJust, listToMaybe)
 import Data.Text (Text)
-import Data.Maybe (isJust)
+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 Model.Query (Query(Query))
+
+type CategoryId = Int64
+
+data Category = Category
+  { id :: CategoryId
+  , name :: Text
+  , color :: Text
+  , createdAt :: UTCTime
+  , editedAt :: Maybe UTCTime
+  , deletedAt :: Maybe UTCTime
+  } deriving Show
+
+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
+  )
 
-import Control.Monad.IO.Class (liftIO)
-
-import Database.Persist hiding (delete)
-
-import Model.Database
-import qualified Model.Json.Category as Json
-
-list :: Persist [Json.Category]
-list = map getJsonCategory <$> selectList [ CategoryDeletedAt ==. Nothing ] []
-
-getJsonCategory :: Entity Category -> Json.Category
-getJsonCategory categoryEntity =
-  Json.Category (entityKey categoryEntity) (categoryName category) (categoryColor category)
-  where category = entityVal categoryEntity
-
-create :: Text -> Text -> Persist CategoryId
-create name color = do
-  now <- liftIO getCurrentTime
-  insert (Category name color now Nothing Nothing)
-
-edit :: CategoryId -> Text -> Text -> Persist Bool
-edit categoryId name color = do
-  mbCategory <- get categoryId
-  if isJust mbCategory
-    then do
-      now <- liftIO getCurrentTime
-      update categoryId
-        [ CategoryEditedAt =. Just now
-        , CategoryName =. name
-        , CategoryColor =. color
-        ]
-      return True
-    else
-      return False
-
-delete :: CategoryId -> Persist Bool
-delete categoryId = do
-  mbCategory <- get categoryId
-  if isJust mbCategory
-    then do
-      now <- liftIO getCurrentTime
-      update categoryId [CategoryDeletedAt =. Just now]
-      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/Database.hs b/src/server/Model/Database.hs
deleted file mode 100644
index ba302de..0000000
--- a/src/server/Model/Database.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-{-# LANGUAGE EmptyDataDecls             #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs                      #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE QuasiQuotes                #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TypeFamilies               #-}
-
-module Model.Database where
-
-import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
-import Control.Monad.Trans.Resource (runResourceT, ResourceT)
-
-import Data.Text
-import Data.Time.Clock (UTCTime)
-import Data.Time.Calendar (Day)
-import Data.Int (Int64)
-
-import Database.Persist.Sqlite
-import Database.Persist.TH
-
-import Resource (Resource, createdAt, editedAt, deletedAt)
-
-import Model.Frequency
-
-import Job.Kind
-
-share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
-User
-  creation UTCTime
-  email Text
-  name Text
-  UniqUserEmail email
-  UniqUserName name
-  deriving Show
-Payment
-  userId UserId
-  name Text
-  cost Int
-  date Day
-  frequency Frequency
-  createdAt UTCTime
-  editedAt UTCTime Maybe
-  deletedAt UTCTime Maybe
-  deriving Show
-Category
-  name Text
-  color Text
-  createdAt UTCTime
-  editedAt UTCTime Maybe
-  deletedAt UTCTime Maybe
-  deriving Show
-PaymentCategory
-  name Text
-  category CategoryId
-  createdAt UTCTime
-  editedAt UTCTime Maybe
-  UniqPaymentCategoryName name
-  deriving Show
-SignIn
-  token Text
-  creation UTCTime
-  email Text
-  isUsed Bool
-  UniqSignInToken token
-  deriving Show
-Job
-  kind Kind
-  lastExecution UTCTime Maybe
-  lastCheck UTCTime Maybe
-  UniqJobName kind
-  deriving Show
-Income
-  userId UserId
-  date Day
-  amount Int
-  createdAt UTCTime
-  editedAt UTCTime Maybe
-  deletedAt UTCTime Maybe
-  deriving Show
-|]
-
-instance Resource Payment where
-  createdAt = paymentCreatedAt
-  editedAt = paymentEditedAt
-  deletedAt = paymentDeletedAt
-
-instance Resource Income where
-  createdAt = incomeCreatedAt
-  editedAt = incomeEditedAt
-  deletedAt = incomeDeletedAt
-
-type Persist a = SqlPersistT (ResourceT (NoLoggingT IO)) a
-
-runDb :: Persist a -> IO a
-runDb = runNoLoggingT . runResourceT . withSqliteConn "database" . runSqlConn
-
-runMigrations :: IO ()
-runMigrations = runDb $ runMigration migrateAll
-
-textToKey :: (ToBackendKey SqlBackend a) => Text -> Key a
-textToKey text = toSqlKey (read (unpack text) :: Int64)
-
-keyToInt64 :: (ToBackendKey SqlBackend a) => Key a -> Int64
-keyToInt64 = fromSqlKey
diff --git a/src/server/Model/Frequency.hs b/src/server/Model/Frequency.hs
index a6ba55c..f9958e1 100644
--- a/src/server/Model/Frequency.hs
+++ b/src/server/Model/Frequency.hs
@@ -6,21 +6,28 @@ module Model.Frequency
   ( Frequency(..)
   ) where
 
-import GHC.Generics
-
-import Web.Scotty
-
-import Database.Persist.TH
-
 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)
 
-derivePersistField "Frequency"
-
 instance Parsable Frequency where parseParam = readEither
 instance FromJSON Frequency
 instance ToJSON 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
index ff6accd..c6cdb55 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -1,73 +1,111 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.Income
-  ( list
+  ( IncomeId
+  , Income(..)
+  , list
   , create
   , editOwn
   , deleteOwn
   , modifiedDuring
   ) where
 
-import Data.Time.Clock (UTCTime, getCurrentTime)
+import Data.Int (Int64)
+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 Model.Query (Query(Query))
+import Model.User (User, UserId)
+import qualified Model.User as User
+import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
 
-import Control.Monad.IO.Class (liftIO)
+type IncomeId = Int64
 
-import Database.Persist
+data Income = Income
+  { id :: IncomeId
+  , userId :: UserId
+  , date :: Day
+  , amount :: Int
+  , createdAt :: UTCTime
+  , editedAt :: Maybe UTCTime
+  , deletedAt :: Maybe UTCTime
+  } deriving Show
 
-import Model.Database
-import qualified Model.Json.Income as Json
+instance Resource Income where
+  resourceCreatedAt = createdAt
+  resourceEditedAt = editedAt
+  resourceDeletedAt = deletedAt
 
-list :: Persist [Json.Income]
-list = map getJsonIncome <$> selectList [IncomeDeletedAt ==. Nothing] []
+instance FromRow Income where
+  fromRow = Income <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
 
-getJsonIncome :: Entity Income -> Json.Income
-getJsonIncome incomeEntity =
-  Json.Income (entityKey incomeEntity) (incomeUserId income) (incomeDate income) (incomeAmount income)
-  where income = entityVal incomeEntity
+list :: Query [Income]
+list = Query (\conn -> SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL")
 
-create :: UserId -> Day -> Int -> Persist IncomeId
-create userId date amount = do
-  now <- liftIO getCurrentTime
-  insert (Income userId date amount now Nothing Nothing)
+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 -> Persist Bool
-editOwn userId incomeId date amount = do
-  mbIncome <- get incomeId
-  case mbIncome of
-    Just income ->
-      if incomeUserId income == userId
-        then do
-          now <- liftIO getCurrentTime
-          update incomeId
-            [ IncomeEditedAt =. Just now
-            , IncomeDate =. date
-            , IncomeAmount =. amount
-            ]
-          return True
-        else
-          return False
-    Nothing ->
-      return False
+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 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 :: Entity User -> IncomeId -> Persist Bool
-deleteOwn user incomeId = do
-  mbIncome <- get incomeId
-  case mbIncome of
-    Just income ->
-      if incomeUserId income == entityKey user
-        then do
-          now <- liftIO getCurrentTime
-          update incomeId [IncomeDeletedAt =. Just now]
-          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 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 -> Persist [Income]
+modifiedDuring :: UTCTime -> UTCTime -> Query [Income]
 modifiedDuring start end =
-  map entityVal <$> selectList
-    (   [IncomeCreatedAt >=. start, IncomeCreatedAt <. end]
-    ||. [IncomeEditedAt >=. Just start, IncomeEditedAt <. Just end]
-    ||. [IncomeDeletedAt >=. Just start, IncomeDeletedAt <. Just 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
index 7610b25..7a9ccea 100644
--- a/src/server/Model/Init.hs
+++ b/src/server/Model/Init.hs
@@ -4,27 +4,27 @@ module Model.Init
   ( getInit
   ) where
 
-import Control.Monad.IO.Class (liftIO)
-
-import Database.Persist
-
-import Model.Database
-
 import Model.Json.Init (Init)
-import qualified Model.Payment as Payment
-import qualified Model.User as User
-import qualified Model.Income as Income
+import Model.Query (Query)
+import Model.User (User)
 import qualified Model.Category as Category
-import qualified Model.PaymentCategory as PaymentCategory
-
+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 :: Entity User -> Persist Init
+getInit :: User -> Query Init
 getInit user =
-  liftIO . runDb $ Init.Init <$>
-    (map User.getJson <$> User.list) <*>
-    (return . entityKey $ user) <*>
-    Payment.list <*>
-    Income.list <*>
-    Category.list <*>
-    PaymentCategory.list
+  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)
diff --git a/src/server/Model/Json/Category.hs b/src/server/Model/Json/Category.hs
index daad4c2..8b5e527 100644
--- a/src/server/Model/Json/Category.hs
+++ b/src/server/Model/Json/Category.hs
@@ -2,14 +2,15 @@
 
 module Model.Json.Category
   ( Category(..)
+  , fromCategory
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
 import Data.Text (Text)
+import GHC.Generics
 
-import Model.Database (CategoryId)
+import Model.Category (CategoryId)
+import qualified Model.Category as M
 
 data Category = Category
   { id :: CategoryId
@@ -18,3 +19,6 @@ data Category = Category
   } 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/CreatePayment.hs b/src/server/Model/Json/CreatePayment.hs
index 5bc6b47..6ab3a5b 100644
--- a/src/server/Model/Json/CreatePayment.hs
+++ b/src/server/Model/Json/CreatePayment.hs
@@ -4,13 +4,12 @@ module Model.Json.CreatePayment
   ( CreatePayment(..)
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
-import Data.Time.Calendar (Day)
 import Data.Text (Text)
+import Data.Time.Calendar (Day)
+import GHC.Generics
 
-import Model.Database (CategoryId)
+import Model.Category (CategoryId)
 import Model.Frequency (Frequency)
 
 data CreatePayment = CreatePayment
diff --git a/src/server/Model/Json/EditCategory.hs b/src/server/Model/Json/EditCategory.hs
index bda3418..a10ce39 100644
--- a/src/server/Model/Json/EditCategory.hs
+++ b/src/server/Model/Json/EditCategory.hs
@@ -4,12 +4,11 @@ module Model.Json.EditCategory
   ( EditCategory(..)
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
 import Data.Text (Text)
+import GHC.Generics
 
-import Model.Database (CategoryId)
+import Model.Category (CategoryId)
 
 data EditCategory = EditCategory
   { id :: CategoryId
diff --git a/src/server/Model/Json/EditIncome.hs b/src/server/Model/Json/EditIncome.hs
index be3c7dc..9b29379 100644
--- a/src/server/Model/Json/EditIncome.hs
+++ b/src/server/Model/Json/EditIncome.hs
@@ -9,7 +9,7 @@ import GHC.Generics
 import Data.Aeson
 import Data.Time.Calendar (Day)
 
-import Model.Database (IncomeId)
+import Model.Income (IncomeId)
 
 data EditIncome = EditIncome
   { id :: IncomeId
diff --git a/src/server/Model/Json/EditPayment.hs b/src/server/Model/Json/EditPayment.hs
index 35f44e5..b7d4d7d 100644
--- a/src/server/Model/Json/EditPayment.hs
+++ b/src/server/Model/Json/EditPayment.hs
@@ -4,14 +4,14 @@ module Model.Json.EditPayment
   ( EditPayment(..)
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
-import Data.Time.Calendar (Day)
 import Data.Text (Text)
+import Data.Time.Calendar (Day)
+import GHC.Generics
 
+import Model.Category (CategoryId)
 import Model.Frequency (Frequency)
-import Model.Database (PaymentId, CategoryId)
+import Model.Payment (PaymentId)
 
 data EditPayment = EditPayment
   { id :: PaymentId
diff --git a/src/server/Model/Json/Income.hs b/src/server/Model/Json/Income.hs
index bb1ac97..7e23a84 100644
--- a/src/server/Model/Json/Income.hs
+++ b/src/server/Model/Json/Income.hs
@@ -2,14 +2,16 @@
 
 module Model.Json.Income
   ( Income(..)
+  , fromIncome
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
 import Data.Time.Calendar (Day)
+import GHC.Generics
 
-import Model.Database (IncomeId, UserId)
+import Model.Income (IncomeId)
+import Model.User (UserId)
+import qualified Model.Income as M
 
 data Income = Income
   { id :: IncomeId
@@ -19,3 +21,6 @@ data Income = Income
   } 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
index b9f7f40..530c3b7 100644
--- a/src/server/Model/Json/Init.hs
+++ b/src/server/Model/Json/Init.hs
@@ -5,17 +5,16 @@ module Model.Json.Init
   , InitResult(..)
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
+import GHC.Generics
 
-import Model.Database (UserId)
-import Model.Json.User (User)
-import Model.Json.Payment (Payment)
-import Model.Json.Income (Income)
 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]
diff --git a/src/server/Model/Json/Payment.hs b/src/server/Model/Json/Payment.hs
index 04c6de8..e406c0f 100644
--- a/src/server/Model/Json/Payment.hs
+++ b/src/server/Model/Json/Payment.hs
@@ -2,16 +2,19 @@
 
 module Model.Json.Payment
   ( Payment(..)
+  , fromPayment
   ) where
 
-import GHC.Generics
-
-import Data.Text (Text)
 import Data.Aeson
+import Data.Text (Text)
 import Data.Time.Calendar (Day)
+import GHC.Generics
+import Prelude hiding (id)
 
-import Model.Database (PaymentId, UserId)
 import Model.Frequency
+import Model.Payment (PaymentId)
+import Model.User (UserId)
+import qualified Model.Payment as M
 
 data Payment = Payment
   { id :: PaymentId
@@ -24,3 +27,14 @@ data Payment = Payment
 
 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
index edd4388..fd97674 100644
--- a/src/server/Model/Json/PaymentCategory.hs
+++ b/src/server/Model/Json/PaymentCategory.hs
@@ -2,14 +2,15 @@
 
 module Model.Json.PaymentCategory
   ( PaymentCategory(..)
+  , fromPaymentCategory
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
 import Data.Text (Text)
+import GHC.Generics
 
-import Model.Database (CategoryId)
+import Model.Category (CategoryId)
+import qualified Model.PaymentCategory as M
 
 data PaymentCategory = PaymentCategory
   { name :: Text
@@ -17,3 +18,6 @@ data PaymentCategory = PaymentCategory
   } 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/User.hs b/src/server/Model/Json/User.hs
index ebc347b..c289fe0 100644
--- a/src/server/Model/Json/User.hs
+++ b/src/server/Model/Json/User.hs
@@ -2,14 +2,15 @@
 
 module Model.Json.User
   ( User(..)
+  , fromUser
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
 import Data.Text (Text)
+import GHC.Generics
 
-import Model.Database (UserId)
+import Model.User (UserId)
+import qualified Model.User as M
 
 data User = User
   { id :: UserId
@@ -19,3 +20,6 @@ data User = User
 
 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/Payment.hs b/src/server/Model/Payment.hs
index d8caaa8..88df477 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,100 +1,164 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Model.Payment
-  ( find
+  ( PaymentId
+  , Payment(..)
+  , find
   , list
   , listMonthly
   , create
+  , createMany
   , editOwn
   , deleteOwn
   , modifiedDuring
   ) where
 
+import Data.Int (Int64)
+import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import Data.Time (UTCTime)
-import Data.Time.Clock (getCurrentTime)
 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 Control.Monad.IO.Class (liftIO)
+import Model.Frequency
+import Model.Query (Query(Query))
+import Model.User (UserId)
+import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
 
-import Database.Persist
+type PaymentId = Int64
 
-import Model.Database
-import Model.Frequency
-import qualified Model.Json.Payment as P
+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
 
-find :: PaymentId -> Persist (Maybe (Entity Payment))
-find paymentId = selectFirst [ PaymentId ==. paymentId ] []
+instance Resource Payment where
+  resourceCreatedAt = createdAt
+  resourceEditedAt = editedAt
+  resourceDeletedAt = deletedAt
 
-list :: Persist [P.Payment]
-list = map getJsonPayment <$> selectList [ PaymentDeletedAt ==. Nothing ] []
+instance FromRow Payment where
+  fromRow = Payment <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
 
-listMonthly :: Persist [Entity Payment]
-listMonthly =
-  selectList
-    [ PaymentDeletedAt ==. Nothing
-    , PaymentFrequency ==. Monthly
+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 (createdAt p)
     ]
-    [ Desc PaymentName ]
-
-getJsonPayment :: Entity Payment -> P.Payment
-getJsonPayment paymentEntity =
-  let payment = entityVal paymentEntity
-  in  P.Payment
-        { P.id = entityKey paymentEntity
-        , P.date = paymentDate payment
-        , P.name = paymentName payment
-        , P.cost = paymentCost payment
-        , P.userId = paymentUserId payment
-        , P.frequency = paymentFrequency payment
-        }
-
-create :: UserId -> Text -> Int -> Day -> Frequency -> Persist PaymentId
-create userId name cost date frequency = do
-  now <- liftIO getCurrentTime
-  insert (Payment userId name cost date frequency now Nothing Nothing)
-
-editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Persist Bool
-editOwn userId paymentId name cost date frequency = do
-  mbPayment <- get paymentId
-  case mbPayment of
-    Just payment ->
-      if paymentUserId payment == userId
-        then do
-          now <- liftIO getCurrentTime
-          update paymentId
-            [ PaymentEditedAt =. Just now
-            , PaymentName =. name
-            , PaymentCost =. cost
-            , PaymentDate =. date
-            , PaymentFrequency =. frequency
-            ]
-          return True
-        else
-          return False
-    Nothing ->
-      return False
-
-deleteOwn :: UserId -> PaymentId -> Persist Bool
-deleteOwn userId paymentId = do
-  mbPayment <- get paymentId
-  case mbPayment of
-    Just payment ->
-      if paymentUserId payment == userId
-        then do
-          now <- liftIO getCurrentTime
-          update paymentId [PaymentDeletedAt =. Just now]
-          return True
-        else
-          return False
-    Nothing ->
-      return False
-
-modifiedDuring :: UTCTime -> UTCTime -> Persist [Payment]
+
+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
+      "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 paymentUserId 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)
+    SQLite.lastInsertRowId conn
+  )
+
+createMany :: [Payment] -> Query ()
+createMany payments =
+  Query (\conn ->
+    SQLite.executeMany
+      conn
+      "INSERT INTO payment (user_id, name, cost, date, frequency, created_at) VALUES (?, ?, ?, ?, ?, ?)"
+      payments
+  )
+
+editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
+editOwn paymentUserId 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
+          then do
+            now <- getCurrentTime
+            SQLite.execute
+              conn
+              "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 paymentUserId 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
+          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 =
-  map entityVal <$> selectList
-    (   [PaymentFrequency ==. Punctual, PaymentCreatedAt >=. start, PaymentCreatedAt <. end]
-    ||. [PaymentFrequency ==. Punctual, PaymentEditedAt >=. Just start, PaymentEditedAt <. Just end]
-    ||. [PaymentFrequency ==. Punctual, PaymentDeletedAt >=. Just start, PaymentDeletedAt <. Just end]
-    )
-    []
+  Query (\conn ->
+    SQLite.query
+      conn
+      "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
index 3b0b858..668fb01 100644
--- a/src/server/Model/PaymentCategory.hs
+++ b/src/server/Model/PaymentCategory.hs
@@ -1,48 +1,71 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Model.PaymentCategory
-  ( list
+  ( PaymentCategoryId
+  , PaymentCategory(..)
+  , list
   , listByCategory
   , save
   ) where
 
-import Control.Monad.IO.Class (liftIO)
-import Data.Maybe (isJust)
-
+import Data.Int (Int64)
+import Data.Maybe (isJust, listToMaybe)
 import Data.Text (Text)
+import Data.Time (UTCTime)
 import Data.Time.Clock (getCurrentTime)
-import Database.Persist
+import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
 import qualified Data.Text as T
+import qualified Database.SQLite.Simple as SQLite
 
-import Model.Database
-import qualified Model.Json.PaymentCategory as Json
+import Model.Category (CategoryId)
+import Model.Query (Query(Query))
 import qualified Utils.Text as T
 
-list :: Persist [Json.PaymentCategory]
-list = map getJsonPaymentCategory <$> selectList [] []
-
-listByCategory :: CategoryId -> Persist [Entity PaymentCategory]
-listByCategory category = selectList [ PaymentCategoryCategory ==. category ] []
-
-getJsonPaymentCategory :: Entity PaymentCategory -> Json.PaymentCategory
-getJsonPaymentCategory entity =
-  Json.PaymentCategory (paymentCategoryName pc) (paymentCategoryCategory pc)
-  where pc = entityVal entity
-
-save :: Text -> CategoryId -> Persist ()
-save newName category = do
-  now <- liftIO getCurrentTime
-  mbPaymentCategory <- selectFirst [PaymentCategoryName ==. (formatPaymentName newName)] []
-  if isJust mbPaymentCategory
-    then
-      updateWhere
-        [ PaymentCategoryName ==. (formatPaymentName newName) ]
-        [ PaymentCategoryCategory =. category
-        , PaymentCategoryEditedAt =. Just now
-        ]
-    else do
-      _ <- insert $ PaymentCategory (formatPaymentName newName) category now Nothing
-      return ()
-
-formatPaymentName :: Text -> Text
-formatPaymentName = T.unaccent . T.toLower
+type PaymentCategoryId = Int64
+
+data PaymentCategory = PaymentCategory
+  { id :: PaymentCategoryId
+  , name :: Text
+  , category :: CategoryId
+  , createdAt :: UTCTime
+  , editedAt :: Maybe UTCTime
+  } deriving Show
+
+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 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
new file mode 100644
index 0000000..d15fb5f
--- /dev/null
+++ b/src/server/Model/Query.hs
@@ -0,0 +1,32 @@
+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
index 06aba5a..c5182f0 100644
--- a/src/server/Model/SignIn.hs
+++ b/src/server/Model/SignIn.hs
@@ -1,40 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.SignIn
-  ( createSignInToken
+  ( SignIn(..)
+  , createSignInToken
   , getSignIn
   , signInTokenToUsed
-  , isLastValidToken
+  , 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 Control.Monad.IO.Class (liftIO)
+import Model.Query (Query(Query))
+import Model.UUID (generateUUID)
 
-import Database.Persist
+type SignInId = Int64
 
-import Model.Database
-import Model.UUID (generateUUID)
+data SignIn = SignIn
+  { id :: SignInId
+  , token :: Text
+  , creation :: UTCTime
+  , email :: Text
+  , isUsed :: Bool
+  } deriving Show
 
-createSignInToken :: Text -> Persist Text
-createSignInToken email = do
-  now <- liftIO getCurrentTime
-  token <- liftIO generateUUID
-  _ <- insert $ SignIn token now email False
-  return token
+instance FromRow SignIn where
+  fromRow = SignIn <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
 
-getSignIn :: Text -> Persist (Maybe (Entity SignIn))
-getSignIn token =
-  selectFirst [SignInToken ==. token] []
+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
+  )
 
-signInTokenToUsed :: SignInId -> Persist ()
+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 =
-  update tokenId [SignInIsUsed =. True]
-
-isLastValidToken :: SignIn -> Persist Bool
-isLastValidToken signIn = do
-  maybe False ((== (signInToken signIn)) . signInToken . entityVal) <$>
-    selectFirst
-      [ SignInEmail ==. (signInEmail signIn)
-      , SignInIsUsed ==. True
-      ]
-      [ Desc SignInCreation ]
+  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/User.hs b/src/server/Model/User.hs
index ab39822..c8a0d53 100644
--- a/src/server/Model/User.hs
+++ b/src/server/Model/User.hs
@@ -1,42 +1,64 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.User
-  ( list
+  ( UserId
+  , User(..)
+  , list
   , getUser
-  , getJson
   , findUser
   , 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.List (find)
+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 Control.Monad.IO.Class (liftIO)
+import Model.Query (Query(Query))
 
-import Database.Persist
+type UserId = Int64
 
-import Model.Database
-import qualified Model.Json.User as Json
+data User = User
+  { id :: UserId
+  , creation :: UTCTime
+  , email :: Text
+  , name :: Text
+  } deriving Show
 
-list :: Persist [Entity User]
-list = selectList [] [Desc UserCreation]
+instance FromRow User where
+  fromRow = User <$> SQLite.field <*> SQLite.field <*> SQLite.field <*> SQLite.field
 
-getUser :: Text -> Persist (Maybe (Entity User))
-getUser email = selectFirst [UserEmail ==. email] []
+list :: Query [User]
+list = Query (\conn -> SQLite.query_ conn "SELECT * from user ORDER BY creation DESC")
 
-findUser :: UserId -> [Entity User] -> Maybe User
-findUser i = fmap entityVal . find ((==) i . entityKey)
+getUser :: Text -> Query (Maybe User)
+getUser userEmail =
+  Query (\conn -> listToMaybe <$>
+    SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail)
+  )
 
-getJson :: Entity User -> Json.User
-getJson userEntity =
-  let user = entityVal userEntity
-  in  Json.User (entityKey userEntity) (userName user) (userEmail user)
+findUser :: UserId -> [User] -> Maybe User
+findUser userId = find ((==) userId . id)
 
-createUser :: Text -> Text -> Persist UserId
-createUser email name = do
-  now <- liftIO getCurrentTime
-  insert $ User now email name
+createUser :: Text -> Text -> Query UserId
+createUser userEmail userName =
+  Query (\conn -> do
+    now <- getCurrentTime
+    SQLite.execute
+      conn
+      "INSERT INTO user (creation, email, name) VALUES (?, ?, ?)"
+      (now, userEmail, userName)
+    SQLite.lastInsertRowId conn
+  )
 
-deleteUser :: Text -> Persist ()
-deleteUser email =
-  deleteWhere [UserEmail ==. email]
+deleteUser :: Text -> Query ()
+deleteUser userEmail =
+  Query (\conn ->
+    SQLite.execute conn "DELETE FROM user WHERE email = ?" (Only userEmail)
+  )