blob: 6a2fefeb0cc09759140f981e0210588dccf53a5d (
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
|
{-# 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 Model.Frequency
import Model.JobKind
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 JobKind
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
|]
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
|
