blob: 7f8326ecf064f1422c97c9635a30f57aa386d6ea (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
{-# 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
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
|
