pwncash/lib/Internal/Types.hs

565 lines
14 KiB
Haskell
Raw Normal View History

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DeriveTraversable #-}
2022-12-14 23:59:23 -05:00
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
2022-12-11 17:51:11 -05:00
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
2022-12-11 17:51:11 -05:00
module Internal.Types where
import Data.Fix (Fix (..), foldFix)
import Data.Functor.Foldable (embed)
import qualified Data.Functor.Foldable.TH as TH
import Database.Persist.Sql hiding (In, Statement)
import Dhall hiding (embed, maybe)
import Dhall.TH
import Language.Haskell.TH.Syntax (Lift)
import RIO
import qualified RIO.Map as M
2023-01-26 23:41:45 -05:00
-- import RIO.State
import qualified RIO.Text as T
import RIO.Time
2022-12-11 17:51:11 -05:00
-------------------------------------------------------------------------------
-- YAML CONFIG
2022-12-11 17:51:11 -05:00
-------------------------------------------------------------------------------
makeHaskellTypesWith
(defaultGenerateOptions {generateToDhallInstance = False})
[ MultipleConstructors "SqlConfig" "(./dhall/Types.dhall).SqlConfig"
, MultipleConstructors "TimeUnit" "(./dhall/Types.dhall).TimeUnit"
, MultipleConstructors "Weekday" "(./dhall/Types.dhall).Weekday"
, MultipleConstructors "WeekdayPat" "(./dhall/Types.dhall).WeekdayPat"
, MultipleConstructors "MDYPat" "(./dhall/Types.dhall).MDYPat"
, MultipleConstructors "DatePat" "(./dhall/Types.dhall).DatePat"
, MultipleConstructors "MatchYMD" "(./dhall/Types.dhall).MatchYMD"
, MultipleConstructors "MatchDate" "(./dhall/Types.dhall).MatchDate"
, MultipleConstructors "SplitNum" "(./dhall/Types.dhall).SplitNum"
, MultipleConstructors "Bucket" "(./dhall/Types.dhall).Bucket"
, SingleConstructor "Currency" "Currency" "(./dhall/Types.dhall).Currency"
, SingleConstructor "Gregorian" "Gregorian" "(./dhall/Types.dhall).Gregorian"
, SingleConstructor "GregorianM" "GregorianM" "(./dhall/Types.dhall).GregorianM"
, SingleConstructor "Interval" "Interval" "(./dhall/Types.dhall).Interval"
, SingleConstructor "Global" "Global" "(./dhall/Types.dhall).Global"
, SingleConstructor "RepeatPat" "RepeatPat" "(./dhall/Types.dhall).RepeatPat"
, SingleConstructor "ModPat" "ModPat" "(./dhall/Types.dhall).ModPat.Type"
, SingleConstructor "CronPat" "CronPat" "(./dhall/Types.dhall).CronPat.Type"
, SingleConstructor "Decimal" "D" "(./dhall/Types.dhall).Decimal"
, SingleConstructor "TxOpts" "TxOpts" "(./dhall/Types.dhall).TxOpts.Type"
, SingleConstructor "MatchVal" "MatchVal" "(./dhall/Types.dhall).MatchVal.Type"
, SingleConstructor "Manual" "Manual" "(./dhall/Types.dhall).Manual"
, SingleConstructor "Tax" "Tax" "(./dhall/Types.dhall).Tax"
]
2022-12-11 18:53:54 -05:00
2022-12-11 17:51:11 -05:00
-------------------------------------------------------------------------------
-- account tree
2022-12-11 17:51:11 -05:00
data AccountTree
= Placeholder T.Text T.Text [AccountTree]
| Account T.Text T.Text
2022-12-11 17:51:11 -05:00
TH.makeBaseFunctor ''AccountTree
deriving instance Generic (AccountTreeF a)
2022-12-11 17:51:11 -05:00
deriving instance FromDhall a => FromDhall (AccountTreeF a)
data AccountRoot_ a = AccountRoot_
{ arAssets :: ![a]
, arEquity :: ![a]
, arExpenses :: ![a]
, arIncome :: ![a]
, arLiabilities :: ![a]
}
deriving (Generic)
2022-12-11 17:51:11 -05:00
type AccountRootF = AccountRoot_ (Fix AccountTreeF)
deriving instance FromDhall AccountRootF
type AccountRoot = AccountRoot_ AccountTree
-------------------------------------------------------------------------------
-- curencies
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq Currency
2022-12-14 23:59:23 -05:00
deriving instance Lift Currency
2022-12-14 23:59:23 -05:00
deriving instance Hashable Currency
2022-12-11 17:51:11 -05:00
type CurID = T.Text
-------------------------------------------------------------------------------
-- DHALL CONFIG
2022-12-11 17:51:11 -05:00
-------------------------------------------------------------------------------
data Config_ a = Config_
{ global :: !Global
, budget :: !Budget
, currencies :: ![Currency]
, statements :: ![Statement]
, accounts :: !a
, sqlConfig :: !SqlConfig
}
deriving (Generic)
2022-12-11 17:51:11 -05:00
type ConfigF = Config_ AccountRootF
type Config = Config_ AccountRoot
unfix :: ConfigF -> Config
unfix c@Config_ {accounts = a} = c {accounts = a'}
2022-12-11 17:51:11 -05:00
where
a' =
AccountRoot_
{ arAssets = unfixTree arAssets
, arEquity = unfixTree arEquity
, arExpenses = unfixTree arExpenses
, arIncome = unfixTree arIncome
, arLiabilities = unfixTree arLiabilities
}
2022-12-11 17:51:11 -05:00
unfixTree f = foldFix embed <$> f a
instance FromDhall a => FromDhall (Config_ a)
-------------------------------------------------------------------------------
-- accounts
2022-12-11 17:51:11 -05:00
type AcntID = T.Text
--------------------------------------------------------------------------------
-- Time Patterns (for assigning when budget events will happen)
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq TimeUnit
deriving instance Show TimeUnit
2022-12-14 23:59:23 -05:00
deriving instance Hashable TimeUnit
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq Weekday
deriving instance Show Weekday
2022-12-14 23:59:23 -05:00
deriving instance Hashable Weekday
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq WeekdayPat
deriving instance Show WeekdayPat
2022-12-14 23:59:23 -05:00
deriving instance Hashable WeekdayPat
2022-12-11 17:51:11 -05:00
deriving instance Show RepeatPat
2022-12-14 23:59:23 -05:00
deriving instance Eq RepeatPat
2022-12-14 23:59:23 -05:00
deriving instance Hashable RepeatPat
2022-12-11 17:51:11 -05:00
deriving instance Show MDYPat
2022-12-14 23:59:23 -05:00
deriving instance Eq MDYPat
2022-12-14 23:59:23 -05:00
deriving instance Hashable MDYPat
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq Gregorian
2022-12-14 23:59:23 -05:00
deriving instance Show Gregorian
2022-12-14 23:59:23 -05:00
deriving instance Hashable Gregorian
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq GregorianM
2022-12-14 23:59:23 -05:00
deriving instance Show GregorianM
2022-12-14 23:59:23 -05:00
deriving instance Hashable GregorianM
2022-12-11 17:51:11 -05:00
-- Dhall.TH rearranges my fields :(
instance Ord Gregorian where
compare
Gregorian {gYear = y, gMonth = m, gDay = d}
Gregorian {gYear = y', gMonth = m', gDay = d'} =
compare y y'
<> compare m m'
<> compare d d'
instance Ord GregorianM where
compare
GregorianM {gmYear = y, gmMonth = m}
GregorianM {gmYear = y', gmMonth = m'} = compare y y' <> compare m m'
2022-12-14 23:59:23 -05:00
deriving instance Eq ModPat
deriving instance Show ModPat
2022-12-14 23:59:23 -05:00
deriving instance Hashable ModPat
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq CronPat
deriving instance Show CronPat
2022-12-14 23:59:23 -05:00
deriving instance Hashable CronPat
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq DatePat
deriving instance Show DatePat
2022-12-14 23:59:23 -05:00
deriving instance Hashable DatePat
2022-12-11 17:51:11 -05:00
--------------------------------------------------------------------------------
-- Budget (projecting into the future)
2022-12-11 17:51:11 -05:00
data Income = Income
{ incGross :: !Decimal
, incCurrency :: !CurID
, incWhen :: !DatePat
, incAccount :: !AcntID
, incPretax :: ![Allocation Decimal]
, incTaxes :: ![Tax]
, incPosttax :: ![Allocation (Maybe Decimal)]
}
deriving (Eq, Hashable, Generic, FromDhall)
2022-12-11 17:51:11 -05:00
data Budget = Budget
{ income :: ![Income]
, expenses :: ![Expense]
}
deriving (Generic, FromDhall)
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq Tax
2022-12-14 23:59:23 -05:00
deriving instance Hashable Tax
2022-12-11 17:51:11 -05:00
data Amount v = Amount
{ amtValue :: !v
, amtDesc :: !T.Text
}
deriving (Functor, Foldable, Traversable, Eq, Hashable, Generic, FromDhall)
2022-12-11 17:51:11 -05:00
data Allocation v = Allocation
{ alloPath :: !AcntID
, alloBucket :: !Bucket
, alloAmts :: ![Amount v]
, alloCurrency :: !CurID
}
deriving (Eq, Hashable, Generic, FromDhall)
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq Bucket
2022-12-14 23:59:23 -05:00
deriving instance Hashable Bucket
2022-12-14 23:59:23 -05:00
deriving instance Show Bucket
2022-12-11 17:51:11 -05:00
data TimeAmount = TimeAmount
{ taWhen :: !DatePat
, taAmt :: Amount Decimal
}
deriving (Eq, Hashable, Generic, FromDhall)
2022-12-11 17:51:11 -05:00
data Expense = Expense
{ expFrom :: !AcntID
, expTo :: !AcntID
, expBucket :: !Bucket
, expAmounts :: ![TimeAmount]
, expCurrency :: !CurID
}
deriving (Eq, Hashable, Generic, FromDhall)
2022-12-11 17:51:11 -05:00
--------------------------------------------------------------------------------
-- Statements (data from the past)
2022-12-11 17:51:11 -05:00
data Statement
= StmtManual Manual
| StmtImport Import
deriving (Generic, FromDhall)
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Hashable Manual
2022-12-11 17:51:11 -05:00
data Split a v c = Split
{ sAcnt :: !a
, sValue :: !v
, sCurrency :: !c
, sComment :: !T.Text
}
deriving (Eq, Generic, Hashable, Show, FromDhall)
2022-12-11 17:51:11 -05:00
type ExpSplit = Split SplitAcnt (Maybe SplitNum) SplitCur
data Tx s = Tx
{ txDescr :: !T.Text
, txDate :: !Day
, txTags :: ![T.Text]
, txSplits :: ![s]
}
deriving (Generic)
2022-12-11 17:51:11 -05:00
type ExpTx = Tx ExpSplit
instance FromDhall ExpTx
2022-12-11 17:51:11 -05:00
data Import = Import
{ impPaths :: ![FilePath]
, impMatches :: ![Match]
, impDelim :: !Word
, impTxOpts :: !TxOpts
, impSkipLines :: !Natural
}
deriving (Hashable, Generic, FromDhall)
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq MatchVal
2022-12-14 23:59:23 -05:00
deriving instance Hashable MatchVal
2022-12-14 23:59:23 -05:00
deriving instance Show MatchVal
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq MatchYMD
2022-12-14 23:59:23 -05:00
deriving instance Hashable MatchYMD
2022-12-14 23:59:23 -05:00
deriving instance Show MatchYMD
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq MatchDate
2022-12-14 23:59:23 -05:00
deriving instance Hashable MatchDate
2022-12-14 23:59:23 -05:00
deriving instance Show MatchDate
2022-12-11 17:51:11 -05:00
-- TODO this just looks silly...but not sure how to simplify it
instance Ord MatchYMD where
compare (Y y) (Y y') = compare y y'
compare (YM g) (YM g') = compare g g'
compare (YMD g) (YMD g') = compare g g'
compare (Y y) (YM g) = compare y (gmYear g) <> LT
compare (Y y) (YMD g) = compare y (gYear g) <> LT
compare (YM g) (Y y') = compare (gmYear g) y' <> GT
compare (YMD g) (Y y') = compare (gYear g) y' <> GT
compare (YM g) (YMD g') = compare g (gregM g') <> LT
compare (YMD g) (YM g') = compare (gregM g) g' <> GT
gregM :: Gregorian -> GregorianM
gregM Gregorian {gYear = y, gMonth = m} =
GregorianM {gmYear = y, gmMonth = m}
2022-12-11 17:51:11 -05:00
instance Ord MatchDate where
compare (On d) (On d') = compare d d'
compare (In d r) (In d' r') = compare d d' <> compare r r'
compare (On d) (In d' _) = compare d d' <> LT
compare (In d _) (On d') = compare d d' <> GT
2022-12-14 23:59:23 -05:00
deriving instance Eq SplitNum
2022-12-14 23:59:23 -05:00
deriving instance Hashable SplitNum
2022-12-14 23:59:23 -05:00
deriving instance Show SplitNum
2022-12-11 17:51:11 -05:00
-- | the value of a field in split (text version)
-- can either be a raw (constant) value, a lookup from the record, or a map
-- between the lookup and some other value
data SplitText t
= ConstT !t
| LookupT !T.Text
| MapT (FieldMap T.Text t)
| Map2T (FieldMap (T.Text, T.Text) t)
deriving (Eq, Generic, Hashable, Show, FromDhall)
2022-12-11 17:51:11 -05:00
type SplitCur = SplitText CurID
type SplitAcnt = SplitText AcntID
data Field k v = Field
{ fKey :: !k
, fVal :: !v
}
deriving (Show, Eq, Hashable, Generic, FromDhall)
2022-12-11 17:51:11 -05:00
type FieldMap k v = Field k (M.Map k v)
data MatchOther
= Desc (Field T.Text T.Text)
| Val (Field T.Text MatchVal)
deriving (Show, Eq, Hashable, Generic, FromDhall)
2022-12-11 17:51:11 -05:00
data ToTx = ToTx
{ ttCurrency :: !SplitCur
, ttPath :: !SplitAcnt
, ttSplit :: ![ExpSplit]
}
deriving (Eq, Generic, Hashable, Show, FromDhall)
2022-12-11 17:51:11 -05:00
data Match = Match
{ mDate :: Maybe MatchDate
, mVal :: MatchVal
, mDesc :: Maybe Text
, mOther :: ![MatchOther]
, mTx :: Maybe ToTx
, mTimes :: Maybe Natural
, mPriority :: !Integer
}
deriving (Eq, Generic, Hashable, Show, FromDhall)
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq TxOpts
2022-12-14 23:59:23 -05:00
deriving instance Hashable TxOpts
2022-12-14 23:59:23 -05:00
deriving instance Show TxOpts
2022-12-11 17:51:11 -05:00
--------------------------------------------------------------------------------
-- Specialized dhall types
2022-12-11 17:51:11 -05:00
2022-12-14 23:59:23 -05:00
deriving instance Eq Decimal
2022-12-14 23:59:23 -05:00
deriving instance Hashable Decimal
2022-12-14 23:59:23 -05:00
deriving instance Show Decimal
2022-12-11 17:51:11 -05:00
--------------------------------------------------------------------------------
-- database cache types
2022-12-11 17:51:11 -05:00
data ConfigHashes = ConfigHashes
{ chIncome :: ![Int]
, chExpense :: ![Int]
, chManual :: ![Int]
, chImport :: ![Int]
}
2022-12-11 17:51:11 -05:00
data ConfigType = CTIncome | CTExpense | CTManual | CTImport
deriving (Eq, Show, Read, Enum)
2022-12-11 17:51:11 -05:00
instance PersistFieldSql ConfigType where
sqlType _ = SqlString
2022-12-11 17:51:11 -05:00
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"
2022-12-11 17:51:11 -05:00
-------------------------------------------------------------------------------
-- misc
2022-12-11 17:51:11 -05:00
data AcntType
= AssetT
| EquityT
| ExpenseT
| IncomeT
| LiabilityT
deriving (Show, Eq, Ord, Lift, Hashable, Generic, Read, FromDhall)
2022-12-14 23:59:23 -05:00
atName :: AcntType -> T.Text
atName AssetT = "asset"
atName EquityT = "equity"
atName ExpenseT = "expense"
atName IncomeT = "income"
2022-12-14 23:59:23 -05:00
atName LiabilityT = "liability"
data AcntPath = AcntPath
{ apType :: !AcntType
, apChildren :: ![T.Text]
}
deriving (Eq, Ord, Show, Lift, Hashable, Generic, Read, FromDhall)
2022-12-14 23:59:23 -05:00
data TxRecord = TxRecord
{ trDate :: !Day
, trAmount :: !Rational
, trDesc :: !T.Text
, trOther :: M.Map T.Text T.Text
2023-01-24 23:24:41 -05:00
, trFile :: FilePath
}
deriving (Show, Eq, Ord)
2022-12-14 23:59:23 -05:00
2022-12-11 17:51:11 -05:00
type Bounds = (Day, Day)
type MaybeBounds = (Maybe Day, Maybe Day)
data Keyed a = Keyed
{ kKey :: !Int64
, kVal :: !a
}
deriving (Eq, Show, Functor)
2022-12-11 17:51:11 -05:00
data Tree a = Branch !a ![Tree a] | Leaf !a deriving (Show)
2022-12-11 17:51:11 -05:00
data AcntSign = Credit | Debit
deriving (Show)
2022-12-11 17:51:11 -05:00
sign2Int :: AcntSign -> Int
sign2Int Debit = 1
2022-12-11 17:51:11 -05:00
sign2Int Credit = 1
accountSign :: AcntType -> AcntSign
accountSign AssetT = Debit
accountSign ExpenseT = Debit
accountSign IncomeT = Credit
2022-12-11 17:51:11 -05:00
accountSign LiabilityT = Credit
accountSign EquityT = Credit
2022-12-11 17:51:11 -05:00
type RawAmount = Amount (Maybe Rational)
type BalAmount = Amount Rational
type RawAllocation = Allocation (Maybe Rational)
type BalAllocation = Allocation Rational
type RawSplit = Split AcntID (Maybe Rational) CurID
type BalSplit = Split AcntID Rational CurID
type RawTx = Tx RawSplit
2022-12-11 17:51:11 -05:00
type BalTx = Tx BalSplit
data MatchRes a = MatchPass a | MatchFail | MatchSkip
2023-01-07 23:42:04 -05:00
2023-01-24 23:24:41 -05:00
data BalanceType = TooFewSplits | NotOneBlank deriving (Show)
2023-01-07 23:42:04 -05:00
2023-01-27 23:33:34 -05:00
data MatchType = MatchNumeric | MatchText deriving (Show)
data SplitIDType = AcntField | CurField deriving (Show)
data LookupSuberr
= SplitIDField SplitIDType
| SplitValField
| MatchField MatchType
deriving (Show)
2023-01-25 23:04:54 -05:00
2023-01-27 20:31:13 -05:00
data AllocationSuberr
= NoAllocations
| ExceededTotal
| MissingBlank
| TooManyBlanks
deriving (Show)
2023-01-24 23:24:41 -05:00
data InsertError
= RegexError T.Text
2023-01-28 20:03:58 -05:00
| MatchValPrecisionError Natural Natural
| ConversionError T.Text
2023-01-27 23:33:34 -05:00
| LookupError LookupSuberr T.Text
2023-01-25 20:52:27 -05:00
| BalanceError BalanceType CurID [RawSplit]
| AllocationError AllocationSuberr DatePat
2023-01-24 23:24:41 -05:00
| StatementError [TxRecord] [Match]
deriving (Show)
2023-01-07 23:42:04 -05:00
2023-01-24 23:24:41 -05:00
newtype InsertException = InsertException [InsertError] deriving (Show)
2023-01-07 23:42:04 -05:00
instance Exception InsertException
2023-01-24 23:24:41 -05:00
type EitherErr = Either InsertError
2023-01-26 23:41:45 -05:00
type EitherErrs = Either [InsertError]
-- type StateErr = State [InsertError]
-- runErrors :: StateErr a -> Either [InsertError] a
-- runErrors x = case runState x [] of
-- (y, []) -> Right y
-- (_, es) -> Left es