aboutsummaryrefslogtreecommitdiff
path: root/src/server/Model/Database.hs
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