REF split up types module to keep compile times sane
This commit is contained in:
parent
5dfbc3ef41
commit
02747b4678
|
@ -11,7 +11,7 @@ import Database.Persist.Monad
|
|||
import Internal.Config
|
||||
import Internal.Database.Ops
|
||||
import Internal.Insert
|
||||
import Internal.Types
|
||||
import Internal.Types.Main
|
||||
import Internal.Utils
|
||||
import Options.Applicative
|
||||
import RIO
|
||||
|
|
|
@ -29,8 +29,10 @@ library
|
|||
Internal.Database.Ops
|
||||
Internal.Insert
|
||||
Internal.Statement
|
||||
Internal.TH
|
||||
Internal.Types
|
||||
Internal.Types.Database
|
||||
Internal.Types.Dhall
|
||||
Internal.Types.Main
|
||||
Internal.Types.TH
|
||||
Internal.Utils
|
||||
other-modules:
|
||||
Paths_budget
|
||||
|
|
|
@ -1,21 +1,11 @@
|
|||
module Internal.Config
|
||||
( readConfig
|
||||
-- , readYaml
|
||||
)
|
||||
where
|
||||
|
||||
-- import Control.Exception
|
||||
-- import Data.Yaml
|
||||
import Dhall hiding (record)
|
||||
import Internal.Types
|
||||
import Internal.Types.Main
|
||||
import RIO
|
||||
|
||||
readConfig :: MonadUnliftIO m => FilePath -> m Config
|
||||
readConfig confpath = liftIO $ unfix <$> inputFile auto confpath
|
||||
|
||||
-- readYaml :: FromJSON a => FilePath -> IO a
|
||||
-- readYaml p = do
|
||||
-- r <- decodeFileEither p
|
||||
-- case r of
|
||||
-- Right a -> return a
|
||||
-- Left e -> throw e
|
||||
|
|
|
@ -29,7 +29,7 @@ import Database.Persist.Sqlite hiding
|
|||
, (||.)
|
||||
)
|
||||
import GHC.Err
|
||||
import Internal.Types
|
||||
import Internal.Types.Main
|
||||
import Internal.Utils
|
||||
import RIO hiding (LogFunc, isNothing, on, (^.))
|
||||
import RIO.List ((\\))
|
||||
|
|
|
@ -11,7 +11,7 @@ import Control.Monad.Except
|
|||
import Data.Hashable
|
||||
import Database.Persist.Monad
|
||||
import Internal.Statement
|
||||
import Internal.Types
|
||||
import Internal.Types.Main
|
||||
import Internal.Utils
|
||||
import RIO hiding (to)
|
||||
import qualified RIO.List as L
|
||||
|
@ -222,7 +222,6 @@ fromShadow cm tx t@ShadowTransfer {stFrom, stTo, stDesc, stRatio, stCurrency, st
|
|||
then Nothing
|
||||
else
|
||||
Just $
|
||||
-- TODO does this actually share the same metadata as the "parent" tx?
|
||||
FlatTransfer
|
||||
{ ftMeta = ftMeta tx
|
||||
, ftWhen = ftWhen tx
|
||||
|
@ -391,6 +390,7 @@ workingDays wds start end
|
|||
daysFull = fromIntegral (length wds') * nFull
|
||||
daysTail = fromIntegral $ length $ takeWhile (< nPart) wds'
|
||||
in return $ fromIntegral $ daysFull + daysTail
|
||||
-- TODO make an error here that says something to the effect of "Period must be positive"
|
||||
| otherwise = throwError $ InsertException undefined
|
||||
where
|
||||
interval = diffDays end start
|
||||
|
|
|
@ -8,7 +8,7 @@ where
|
|||
import Control.Monad.Error.Class
|
||||
import Control.Monad.Except
|
||||
import Data.Csv
|
||||
import Internal.Types
|
||||
import Internal.Types.Main
|
||||
import Internal.Utils
|
||||
import RIO
|
||||
import qualified RIO.ByteString.Lazy as BL
|
||||
|
|
|
@ -0,0 +1,75 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
-- | Types corresponding to the database model
|
||||
module Internal.Types.Database where
|
||||
|
||||
import Database.Persist.Sql hiding (Desc, In, Statement)
|
||||
import Database.Persist.TH
|
||||
import RIO
|
||||
import qualified RIO.Text as T
|
||||
import RIO.Time
|
||||
|
||||
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
|
||||
precision Int
|
||||
deriving Show Eq
|
||||
TagR sql=tags
|
||||
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
|
||||
deriving Show Eq
|
||||
SplitR sql=splits
|
||||
transaction TransactionRId OnDeleteCascade
|
||||
currency CurrencyRId OnDeleteCascade
|
||||
account AccountRId OnDeleteCascade
|
||||
memo T.Text
|
||||
value Rational
|
||||
deriving Show Eq
|
||||
TagRelationR sql=tag_relations
|
||||
split SplitRId OnDeleteCascade
|
||||
tag TagRId OnDeleteCascade
|
||||
BudgetLabelR sql=budget_labels
|
||||
split SplitRId OnDeleteCascade
|
||||
budgetName T.Text
|
||||
deriving Show Eq
|
||||
|]
|
||||
|
||||
data ConfigType = CTBudget | CTManual | CTImport
|
||||
deriving (Eq, Show, Read, Enum)
|
||||
|
||||
instance PersistFieldSql ConfigType where
|
||||
sqlType _ = SqlString
|
||||
|
||||
instance PersistField ConfigType where
|
||||
toPersistValue = PersistText . T.pack . show
|
||||
|
||||
-- TODO these error messages *might* be good enough?
|
||||
fromPersistValue (PersistText v) =
|
||||
maybe (Left $ "could not parse: " <> v) Right $ readMaybe $ T.unpack v
|
||||
fromPersistValue _ = Left "wrong type"
|
|
@ -4,29 +4,24 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Internal.Types where
|
||||
-- | Types corresponding to the configuration tree (written in Dhall)
|
||||
module Internal.Types.Dhall where
|
||||
|
||||
import Control.Monad.Except
|
||||
import Data.Fix (Fix (..), foldFix)
|
||||
import Data.Functor.Foldable (embed)
|
||||
import qualified Data.Functor.Foldable.TH as TH
|
||||
import Database.Persist.Sql hiding (Desc, In, Statement)
|
||||
import Database.Persist.TH
|
||||
import Dhall hiding (embed, maybe)
|
||||
import Dhall.TH
|
||||
import Internal.TH (deriveProduct)
|
||||
import Internal.Types.TH (deriveProduct)
|
||||
import Language.Haskell.TH.Syntax (Lift)
|
||||
import RIO
|
||||
import qualified RIO.Map as M
|
||||
import qualified RIO.NonEmpty as NE
|
||||
import qualified RIO.Text as T
|
||||
import RIO.Time
|
||||
import Text.Regex.TDFA
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- DHALL CONFIG
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
makeHaskellTypesWith
|
||||
(defaultGenerateOptions {generateToDhallInstance = False, generateFromDhallInstance = False})
|
||||
[ MultipleConstructors "SqlConfig" "(./dhall/Types.dhall).SqlConfig"
|
||||
|
@ -528,270 +523,5 @@ data StatementParser re = StatementParser
|
|||
|
||||
deriving instance Show (StatementParser T.Text)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- DATABASE MODEL
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
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
|
||||
precision Int
|
||||
deriving Show Eq
|
||||
TagR sql=tags
|
||||
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
|
||||
deriving Show Eq
|
||||
SplitR sql=splits
|
||||
transaction TransactionRId OnDeleteCascade
|
||||
currency CurrencyRId OnDeleteCascade
|
||||
account AccountRId OnDeleteCascade
|
||||
memo T.Text
|
||||
value Rational
|
||||
deriving Show Eq
|
||||
TagRelationR sql=tag_relations
|
||||
split SplitRId OnDeleteCascade
|
||||
tag TagRId OnDeleteCascade
|
||||
BudgetLabelR sql=budget_labels
|
||||
split SplitRId OnDeleteCascade
|
||||
budgetName T.Text
|
||||
deriving Show Eq
|
||||
|]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- database cache types
|
||||
|
||||
data ConfigHashes = ConfigHashes
|
||||
{ chIncome :: ![Int]
|
||||
, chExpense :: ![Int]
|
||||
, chManual :: ![Int]
|
||||
, chImport :: ![Int]
|
||||
}
|
||||
|
||||
data ConfigType = CTBudget | CTManual | CTImport
|
||||
deriving (Eq, Show, Read, Enum)
|
||||
|
||||
instance PersistFieldSql ConfigType where
|
||||
sqlType _ = SqlString
|
||||
|
||||
instance PersistField ConfigType where
|
||||
toPersistValue = PersistText . T.pack . show
|
||||
|
||||
-- TODO these error messages *might* be good enough?
|
||||
fromPersistValue (PersistText v) =
|
||||
maybe (Left $ "could not parse: " <> v) Right $ readMaybe $ T.unpack v
|
||||
fromPersistValue _ = Left "wrong type"
|
||||
|
||||
type AccountMap = M.Map AcntID (AccountRId, AcntSign, AcntType)
|
||||
|
||||
type CurrencyMap = M.Map CurID (CurrencyRId, Natural)
|
||||
|
||||
type TagMap = M.Map TagID TagRId
|
||||
|
||||
data DBState = DBState
|
||||
{ kmCurrency :: !CurrencyMap
|
||||
, kmAccount :: !AccountMap
|
||||
, kmTag :: !TagMap
|
||||
, kmBudgetInterval :: !Bounds
|
||||
, kmStatementInterval :: !Bounds
|
||||
, kmNewCommits :: ![Int]
|
||||
, kmOldCommits :: ![Int]
|
||||
, kmConfigDir :: !FilePath
|
||||
, kmTagAll :: ![Entity TagR]
|
||||
, kmAcntPaths :: ![AccountPathR]
|
||||
, kmAcntsOld :: ![Entity AccountR]
|
||||
, kmCurrenciesOld :: ![Entity CurrencyR]
|
||||
}
|
||||
|
||||
type CurrencyM = Reader CurrencyMap
|
||||
|
||||
type KeySplit = Entry AccountRId Rational CurrencyRId TagRId
|
||||
|
||||
type KeyTx = Tx KeySplit
|
||||
|
||||
type TreeR = Tree ([T.Text], AccountRId)
|
||||
|
||||
type Balances = M.Map AccountRId Rational
|
||||
|
||||
type BalanceM = ReaderT (MVar Balances)
|
||||
|
||||
type MonadFinance = MonadReader DBState
|
||||
|
||||
askDBState :: MonadFinance m => (DBState -> a) -> m a
|
||||
askDBState = asks
|
||||
|
||||
class MonadUnliftIO m => MonadBalance m where
|
||||
askBalances :: m (MVar Balances)
|
||||
|
||||
withBalances :: (Balances -> m a) -> m a
|
||||
withBalances f = do
|
||||
bs <- askBalances
|
||||
withMVar bs f
|
||||
|
||||
modifyBalances :: (Balances -> m (Balances, a)) -> m a
|
||||
modifyBalances f = do
|
||||
bs <- askBalances
|
||||
modifyMVar bs f
|
||||
|
||||
lookupBalance :: AccountRId -> m Rational
|
||||
lookupBalance i = withBalances $ return . fromMaybe 0 . M.lookup i
|
||||
|
||||
addBalance :: AccountRId -> Rational -> m ()
|
||||
addBalance i v =
|
||||
modifyBalances $ return . (,()) . M.alter (Just . maybe v (v +)) i
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- misc
|
||||
|
||||
data AcntType
|
||||
= AssetT
|
||||
| EquityT
|
||||
| ExpenseT
|
||||
| IncomeT
|
||||
| LiabilityT
|
||||
deriving (Show, Eq, Ord, Lift, Hashable, Generic, Read, FromDhall)
|
||||
|
||||
atName :: AcntType -> T.Text
|
||||
atName AssetT = "asset"
|
||||
atName EquityT = "equity"
|
||||
atName ExpenseT = "expense"
|
||||
atName IncomeT = "income"
|
||||
atName LiabilityT = "liability"
|
||||
|
||||
data AcntPath = AcntPath
|
||||
{ apType :: !AcntType
|
||||
, apChildren :: ![T.Text]
|
||||
}
|
||||
deriving (Eq, Ord, Show, Lift, Hashable, Generic, Read, FromDhall)
|
||||
|
||||
data TxRecord = TxRecord
|
||||
{ trDate :: !Day
|
||||
, trAmount :: !Rational
|
||||
, trDesc :: !T.Text
|
||||
, trOther :: !(M.Map T.Text T.Text)
|
||||
, trFile :: !FilePath
|
||||
}
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
type Bounds = (Day, Natural)
|
||||
|
||||
data Keyed a = Keyed
|
||||
{ kKey :: !Int64
|
||||
, kVal :: !a
|
||||
}
|
||||
deriving (Eq, Show, Functor)
|
||||
|
||||
data Tree a = Branch !a ![Tree a] | Leaf !a deriving (Show)
|
||||
|
||||
data AcntSign = Credit | Debit
|
||||
deriving (Show)
|
||||
|
||||
sign2Int :: AcntSign -> Int
|
||||
sign2Int Debit = 1
|
||||
sign2Int Credit = 1
|
||||
|
||||
accountSign :: AcntType -> AcntSign
|
||||
accountSign AssetT = Debit
|
||||
accountSign ExpenseT = Debit
|
||||
accountSign IncomeT = Credit
|
||||
accountSign LiabilityT = Credit
|
||||
accountSign EquityT = Credit
|
||||
|
||||
type RawSplit = Entry AcntID (Maybe Rational) CurID TagID
|
||||
|
||||
type BalSplit = Entry AcntID Rational CurID TagID
|
||||
|
||||
type RawTx = Tx RawSplit
|
||||
|
||||
type BalTx = Tx BalSplit
|
||||
|
||||
data MatchRes a = MatchPass !a | MatchFail | MatchSkip
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- exception types
|
||||
|
||||
data BalanceType = TooFewSplits | NotOneBlank deriving (Show)
|
||||
|
||||
data MatchType = MatchNumeric | MatchText deriving (Show)
|
||||
|
||||
data SplitIDType = AcntField | CurField | TagField deriving (Show)
|
||||
|
||||
data LookupSuberr
|
||||
= SplitIDField !SplitIDType
|
||||
| SplitValField
|
||||
| MatchField !MatchType
|
||||
| DBKey !SplitIDType
|
||||
deriving (Show)
|
||||
|
||||
data AllocationSuberr
|
||||
= NoAllocations
|
||||
| ExceededTotal
|
||||
| MissingBlank
|
||||
| TooManyBlanks
|
||||
deriving (Show)
|
||||
|
||||
data PatternSuberr = ZeroLength | ZeroRepeats deriving (Show)
|
||||
|
||||
data InsertError
|
||||
= RegexError !T.Text
|
||||
| MatchValPrecisionError !Natural !Natural
|
||||
| AccountError !AcntID !(NE.NonEmpty AcntType)
|
||||
| InsertIOError !T.Text
|
||||
| ParseError !T.Text
|
||||
| ConversionError !T.Text
|
||||
| LookupError !LookupSuberr !T.Text
|
||||
| BalanceError !BalanceType !CurID ![RawSplit]
|
||||
| IncomeError !Day !T.Text !Rational
|
||||
| PatternError !Natural !Natural !(Maybe Natural) !PatternSuberr
|
||||
| BoundsError !Gregorian !(Maybe Gregorian)
|
||||
| StatementError ![TxRecord] ![MatchRe]
|
||||
| PeriodError !Day !Day
|
||||
deriving (Show)
|
||||
|
||||
newtype InsertException = InsertException [InsertError]
|
||||
deriving (Show, Semigroup) via [InsertError]
|
||||
|
||||
instance Exception InsertException
|
||||
|
||||
type MonadInsertError = MonadError InsertException
|
||||
|
||||
type InsertExceptT = ExceptT InsertException
|
||||
|
||||
type InsertExcept = InsertExceptT Identity
|
||||
|
||||
data XGregorian = XGregorian
|
||||
{ xgYear :: !Int
|
||||
, xgMonth :: !Int
|
||||
, xgDay :: !Int
|
||||
, xgDayOfWeek :: !Int
|
||||
}
|
||||
|
||||
type MatchRe = StatementParser (T.Text, Regex)
|
||||
|
||||
type TxOptsRe = TxOpts (T.Text, Regex)
|
||||
|
||||
type FieldMatcherRe = FieldMatcher (T.Text, Regex)
|
||||
|
||||
instance Show (StatementParser (T.Text, Regex)) where
|
||||
show = show . fmap fst
|
|
@ -0,0 +1,226 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
-- | Other types used throughout the program; kept in its own module to prevent
|
||||
-- circular imports
|
||||
module Internal.Types.Main
|
||||
( module Internal.Types.Main
|
||||
, module Internal.Types.Dhall
|
||||
, module Internal.Types.Database
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Except
|
||||
import Database.Persist.Sql hiding (Desc, In, Statement)
|
||||
import Dhall hiding (embed, maybe)
|
||||
import Internal.Types.Database
|
||||
import Internal.Types.Dhall
|
||||
import Language.Haskell.TH.Syntax (Lift)
|
||||
import RIO
|
||||
import qualified RIO.Map as M
|
||||
import qualified RIO.NonEmpty as NE
|
||||
import qualified RIO.Text as T
|
||||
import RIO.Time
|
||||
import Text.Regex.TDFA
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- database cache types
|
||||
|
||||
data ConfigHashes = ConfigHashes
|
||||
{ chIncome :: ![Int]
|
||||
, chExpense :: ![Int]
|
||||
, chManual :: ![Int]
|
||||
, chImport :: ![Int]
|
||||
}
|
||||
|
||||
type AccountMap = M.Map AcntID (AccountRId, AcntSign, AcntType)
|
||||
|
||||
type CurrencyMap = M.Map CurID (CurrencyRId, Natural)
|
||||
|
||||
type TagMap = M.Map TagID TagRId
|
||||
|
||||
data DBState = DBState
|
||||
{ kmCurrency :: !CurrencyMap
|
||||
, kmAccount :: !AccountMap
|
||||
, kmTag :: !TagMap
|
||||
, kmBudgetInterval :: !Bounds
|
||||
, kmStatementInterval :: !Bounds
|
||||
, kmNewCommits :: ![Int]
|
||||
, kmOldCommits :: ![Int]
|
||||
, kmConfigDir :: !FilePath
|
||||
, kmTagAll :: ![Entity TagR]
|
||||
, kmAcntPaths :: ![AccountPathR]
|
||||
, kmAcntsOld :: ![Entity AccountR]
|
||||
, kmCurrenciesOld :: ![Entity CurrencyR]
|
||||
}
|
||||
|
||||
type CurrencyM = Reader CurrencyMap
|
||||
|
||||
type KeySplit = Entry AccountRId Rational CurrencyRId TagRId
|
||||
|
||||
type KeyTx = Tx KeySplit
|
||||
|
||||
type TreeR = Tree ([T.Text], AccountRId)
|
||||
|
||||
type Balances = M.Map AccountRId Rational
|
||||
|
||||
type BalanceM = ReaderT (MVar Balances)
|
||||
|
||||
type MonadFinance = MonadReader DBState
|
||||
|
||||
askDBState :: MonadFinance m => (DBState -> a) -> m a
|
||||
askDBState = asks
|
||||
|
||||
class MonadUnliftIO m => MonadBalance m where
|
||||
askBalances :: m (MVar Balances)
|
||||
|
||||
withBalances :: (Balances -> m a) -> m a
|
||||
withBalances f = do
|
||||
bs <- askBalances
|
||||
withMVar bs f
|
||||
|
||||
modifyBalances :: (Balances -> m (Balances, a)) -> m a
|
||||
modifyBalances f = do
|
||||
bs <- askBalances
|
||||
modifyMVar bs f
|
||||
|
||||
lookupBalance :: AccountRId -> m Rational
|
||||
lookupBalance i = withBalances $ return . fromMaybe 0 . M.lookup i
|
||||
|
||||
addBalance :: AccountRId -> Rational -> m ()
|
||||
addBalance i v =
|
||||
modifyBalances $ return . (,()) . M.alter (Just . maybe v (v +)) i
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- misc
|
||||
|
||||
data AcntType
|
||||
= AssetT
|
||||
| EquityT
|
||||
| ExpenseT
|
||||
| IncomeT
|
||||
| LiabilityT
|
||||
deriving (Show, Eq, Ord, Lift, Hashable, Generic, Read, FromDhall)
|
||||
|
||||
atName :: AcntType -> T.Text
|
||||
atName AssetT = "asset"
|
||||
atName EquityT = "equity"
|
||||
atName ExpenseT = "expense"
|
||||
atName IncomeT = "income"
|
||||
atName LiabilityT = "liability"
|
||||
|
||||
data AcntPath = AcntPath
|
||||
{ apType :: !AcntType
|
||||
, apChildren :: ![T.Text]
|
||||
}
|
||||
deriving (Eq, Ord, Show, Lift, Hashable, Generic, Read, FromDhall)
|
||||
|
||||
data TxRecord = TxRecord
|
||||
{ trDate :: !Day
|
||||
, trAmount :: !Rational
|
||||
, trDesc :: !T.Text
|
||||
, trOther :: !(M.Map T.Text T.Text)
|
||||
, trFile :: !FilePath
|
||||
}
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- TODO pick a better name for this (something like DayInterval or something)
|
||||
type Bounds = (Day, Natural)
|
||||
|
||||
data Keyed a = Keyed
|
||||
{ kKey :: !Int64
|
||||
, kVal :: !a
|
||||
}
|
||||
deriving (Eq, Show, Functor)
|
||||
|
||||
data Tree a = Branch !a ![Tree a] | Leaf !a deriving (Show)
|
||||
|
||||
data AcntSign = Credit | Debit
|
||||
deriving (Show)
|
||||
|
||||
sign2Int :: AcntSign -> Int
|
||||
sign2Int Debit = 1
|
||||
sign2Int Credit = 1
|
||||
|
||||
accountSign :: AcntType -> AcntSign
|
||||
accountSign AssetT = Debit
|
||||
accountSign ExpenseT = Debit
|
||||
accountSign IncomeT = Credit
|
||||
accountSign LiabilityT = Credit
|
||||
accountSign EquityT = Credit
|
||||
|
||||
type RawSplit = Entry AcntID (Maybe Rational) CurID TagID
|
||||
|
||||
type BalSplit = Entry AcntID Rational CurID TagID
|
||||
|
||||
type RawTx = Tx RawSplit
|
||||
|
||||
type BalTx = Tx BalSplit
|
||||
|
||||
data MatchRes a = MatchPass !a | MatchFail | MatchSkip
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- exception types
|
||||
|
||||
data BalanceType = TooFewSplits | NotOneBlank deriving (Show)
|
||||
|
||||
data MatchType = MatchNumeric | MatchText deriving (Show)
|
||||
|
||||
data SplitIDType = AcntField | CurField | TagField deriving (Show)
|
||||
|
||||
data LookupSuberr
|
||||
= SplitIDField !SplitIDType
|
||||
| SplitValField
|
||||
| MatchField !MatchType
|
||||
| DBKey !SplitIDType
|
||||
deriving (Show)
|
||||
|
||||
data AllocationSuberr
|
||||
= NoAllocations
|
||||
| ExceededTotal
|
||||
| MissingBlank
|
||||
| TooManyBlanks
|
||||
deriving (Show)
|
||||
|
||||
data PatternSuberr = ZeroLength | ZeroRepeats deriving (Show)
|
||||
|
||||
data InsertError
|
||||
= RegexError !T.Text
|
||||
| MatchValPrecisionError !Natural !Natural
|
||||
| AccountError !AcntID !(NE.NonEmpty AcntType)
|
||||
| InsertIOError !T.Text
|
||||
| ParseError !T.Text
|
||||
| ConversionError !T.Text
|
||||
| LookupError !LookupSuberr !T.Text
|
||||
| BalanceError !BalanceType !CurID ![RawSplit]
|
||||
| IncomeError !Day !T.Text !Rational
|
||||
| PatternError !Natural !Natural !(Maybe Natural) !PatternSuberr
|
||||
| BoundsError !Gregorian !(Maybe Gregorian)
|
||||
| StatementError ![TxRecord] ![MatchRe]
|
||||
| PeriodError !Day !Day
|
||||
deriving (Show)
|
||||
|
||||
newtype InsertException = InsertException [InsertError]
|
||||
deriving (Show, Semigroup) via [InsertError]
|
||||
|
||||
instance Exception InsertException
|
||||
|
||||
type MonadInsertError = MonadError InsertException
|
||||
|
||||
type InsertExceptT = ExceptT InsertException
|
||||
|
||||
type InsertExcept = InsertExceptT Identity
|
||||
|
||||
data XGregorian = XGregorian
|
||||
{ xgYear :: !Int
|
||||
, xgMonth :: !Int
|
||||
, xgDay :: !Int
|
||||
, xgDayOfWeek :: !Int
|
||||
}
|
||||
|
||||
type MatchRe = StatementParser (T.Text, Regex)
|
||||
|
||||
type TxOptsRe = TxOpts (T.Text, Regex)
|
||||
|
||||
type FieldMatcherRe = FieldMatcher (T.Text, Regex)
|
|
@ -1,4 +1,5 @@
|
|||
module Internal.TH where
|
||||
-- | Helper functions so I don't need to write lots of dhall instances
|
||||
module Internal.Types.TH where
|
||||
|
||||
import Language.Haskell.TH.Syntax (Dec (..), Q (..), Type (..), mkName)
|
||||
import RIO
|
|
@ -27,15 +27,6 @@ module Internal.Utils
|
|||
, combineErrorIOM3
|
||||
, collectErrorsIO
|
||||
, mapErrorsIO
|
||||
-- , leftToMaybe
|
||||
-- , concatEithers2
|
||||
-- , concatEithers3
|
||||
-- , concatEither3
|
||||
-- , concatEither2
|
||||
-- , concatEitherL
|
||||
-- , concatEithersL
|
||||
-- , concatEither2M
|
||||
-- , concatEithers2M
|
||||
, parseRational
|
||||
, showError
|
||||
, unlessLeft_
|
||||
|
@ -51,7 +42,6 @@ module Internal.Utils
|
|||
, sndOf3
|
||||
, thdOf3
|
||||
, xGregToDay
|
||||
-- , plural
|
||||
, compileMatch
|
||||
, compileOptions
|
||||
, dateMatches
|
||||
|
@ -66,7 +56,7 @@ import Control.Monad.Except
|
|||
import Control.Monad.Reader
|
||||
import Data.Time.Format.ISO8601
|
||||
import GHC.Real
|
||||
import Internal.Types
|
||||
import Internal.Types.Main
|
||||
import RIO
|
||||
import qualified RIO.List as L
|
||||
import qualified RIO.Map as M
|
||||
|
|
Loading…
Reference in New Issue