blob: 0915afe1284390ccd33bd6a3842f60f86f87559a (
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
|
{-# 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.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
creation UTCTime
name Text
cost Int
deletedAt UTCTime Maybe
frequency Frequency
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
creation UTCTime
amount Int
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
|
