84 lines
2.3 KiB
Haskell
84 lines
2.3 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DerivingStrategies #-}
|
|
{-# LANGUAGE EmptyDataDecls #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE StandaloneDeriving #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
module Internal.Database.Model where
|
|
|
|
import Control.Monad.Trans.Reader
|
|
|
|
import qualified Data.Map as M
|
|
import qualified Data.Text as T
|
|
import Data.Time
|
|
|
|
import Database.Esqueleto.Experimental
|
|
import Database.Persist.TH
|
|
|
|
import Internal.Types
|
|
|
|
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
|
|
CommitR sql=commits
|
|
hash Int
|
|
type ConfigType
|
|
deriving Show Eq
|
|
CurrencyR sql=currencies
|
|
symbol T.Text
|
|
fullname T.Text
|
|
deriving Show Eq
|
|
AccountR sql=accounts
|
|
name T.Text
|
|
fullpath T.Text
|
|
desc T.Text
|
|
deriving Show Eq
|
|
AccountPathR sql=account_paths
|
|
parent AccountRId OnDeleteCascade
|
|
child AccountRId OnDeleteCascade
|
|
depth Int
|
|
deriving Show Eq
|
|
TransactionR sql=transactions
|
|
commit CommitRId OnDeleteCascade
|
|
date Day
|
|
description T.Text
|
|
bucket T.Text Maybe
|
|
deriving Show Eq
|
|
SplitR sql=splits
|
|
transaction TransactionRId OnDeleteCascade
|
|
currency CurrencyRId OnDeleteCascade
|
|
account AccountRId OnDeleteCascade
|
|
memo T.Text
|
|
value Rational
|
|
deriving Show Eq
|
|
|]
|
|
|
|
type AccountMap = M.Map AcntID (AccountRId, AcntSign)
|
|
|
|
type CurrencyMap = M.Map CurID CurrencyRId
|
|
|
|
data DBState = DBState
|
|
{ kmCurrency :: !CurrencyMap
|
|
, kmAccount :: !AccountMap
|
|
, kmBudgetInterval :: !MaybeBounds
|
|
, kmStatementInterval :: !MaybeBounds
|
|
, kmNewCommits :: ![Int]
|
|
}
|
|
|
|
type MappingT m a = ReaderT DBState (SqlPersistT m) a
|
|
|
|
type KeySplit = Split AccountRId Rational CurrencyRId
|
|
|
|
type KeyTx = Tx KeySplit
|
|
|
|
type TreeR = Tree ([T.Text], AccountRId)
|