WIP use dhall for types

This commit is contained in:
Nathan Dwarshuis 2022-12-14 23:59:23 -05:00
parent 68e4ce36ca
commit 5e46efff9e
6 changed files with 426 additions and 227 deletions

255
dhall/Types.dhall Normal file
View File

@ -0,0 +1,255 @@
let Map =
https://prelude.dhall-lang.org/v21.1.0/Map/Type
sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
let CurID = Text
let AcntID = Text
let SqlConfig {- TODO pgsql -} = < Sqlite : Text | Postgres >
let Currency = { curSymbol : CurID, curFullname : Text }
let Gregorian = { gYear : Natural, gMonth : Natural, gDay : Natural }
let GregorianM = { gmYear : Natural, gmMonth : Natural }
let Interval = { intStart : Optional Gregorian, intEnd : Optional Gregorian }
let Global = { budgetInterval : Interval, statementInterval : Interval }
let TimeUnit = < Day | Week | Month | Year >
let Weekday = < Mon | Tue | Wed | Thu | Fri | Sat | Sun >
let RepeatPat =
{ rpStart : Natural, rpBy : Natural, rpRepeats : Optional Natural }
let MDYPat = < Single : Natural | Multi : List Natural | Repeat : RepeatPat >
let ModPat =
{ Type =
{ mpStart : Optional Gregorian
, mpBy : Natural
, mpUnit : TimeUnit
, mpRepeats : Optional Natural
}
, default = { mpStart = None Gregorian, mpRepeats = None Natural }
}
let WeekdayPat = < OnDay : Weekday | OnDays : List Weekday >
let CronPat =
{ Type =
{ cronWeekly : Optional WeekdayPat
, cronYear : Optional MDYPat
, cronMonth : Optional MDYPat
, cronDay : Optional MDYPat
}
, default =
{ cronWeekly = None WeekdayPat
, cronYear = None MDYPat
, cronMonth = None MDYPat
, cronDay = None MDYPat
}
}
let DatePat = < Cron : CronPat.Type | Mod : ModPat.Type >
let Decimal =
{ whole : Natural, decimal : Natural, precision : Natural, sign : Bool }
let TxOpts =
{ Type =
{ toDate : Text
, toAmount : Text
, toDesc : Text
, toOther : List Text
, toDateFmt : Text
, toAmountFmt : Text
}
, default =
{ toDate = "Date"
, toAmount = "Amount"
, toDesc = "Description"
, toOther = [] : List Text
, toDateFmt = "%0m/%0d/%Y"
, toAmountFmt = "([-+])?([0-9]+)\\.?([0-9]+)?"
}
}
let Field = \(k : Type) -> \(v : Type) -> { fKey : k, fVal : v }
let FieldMap = \(k : Type) -> \(v : Type) -> Field k (Map k v)
let MatchVal =
{ Type =
{ mvSign : Optional Bool
, mvNum : Optional Natural
, mvDen : Optional Natural
, mvPrec : Natural
}
, default =
{ mvSign = None Bool
, mvNum = None Natural
, mvDen = None Natural
, mvPrec = 2
}
}
let MatchYMD = < Y : Natural | YM : GregorianM | YMD : Gregorian >
let MatchDate = < On : MatchYMD | In : { _1 : MatchYMD, _2 : Natural } >
let MatchDesc = < Re : Text | Exact : Text >
let MatchOther =
< Desc : Field Text MatchDesc | Val : Field Text MatchVal.Type >
let SplitNum = < LookupN : Text | ConstN : Decimal | AmountN >
let SplitText =
\(t : Type) ->
< ConstT : t
| LookupT : Text
| MapT : FieldMap Text t
| Map2T : FieldMap { _1 : Text, _2 : Text } t
>
let SplitCur = SplitText CurID
let SplitAcnt = SplitText AcntID
let Split =
\(a : Type) ->
\(v : Type) ->
\(c : Type) ->
{ sAcnt : a, sValue : v, sCurrency : c, sComment : Text }
let ExpSplit =
{ Type = Split SplitAcnt (Optional SplitNum) SplitCur
, default = { sValue = None SplitNum, sComment = "" }
}
let ToTx =
{ ttCurrency : SplitCur
, ttPath : SplitAcnt
, ttSplit : List ExpSplit.Type
}
let Match =
{ Type =
{ mDate : Optional MatchDate
, mVal : MatchVal.Type
, mDesc : Optional MatchDesc
, mOther : List MatchOther
, mTx : Optional ToTx
, mTimes : Optional Natural
, mPriority : Integer
}
, default =
{ mDate = None MatchDate
, mVal = MatchVal::{=}
, mDesc = None MatchDesc
, mOther = [] : List MatchOther
, mTx = None ToTx
, mTimes = None Natural
, mPriority = +0
}
}
let Manual =
{ manualDate : DatePat
, manualFrom : AcntID
, manualTo : AcntID
, manualValue : Decimal
, manualDesc : Text
, manualCurrency : CurID
}
let Import =
{ impPaths : List Text
, impMatches : List Match.Type
, impDelim : Natural
, impTxOpts : TxOpts.Type
, impSkipLines : Natural
}
let Statement = < StmtManual : Manual | StmtImport : Import >
let Bucket = < Fixed | Investment | Savings | Guiltless >
let Amount = \(v : Type) -> { amtValue : v, amtDesc : Text }
let TimeAmount = { taWhen : DatePat, taAmt : Amount Decimal }
let Tax = { taxAcnt : AcntID, taxValue : Decimal }
let Allocation =
\(v : Type) ->
{ alloPath : AcntID
, alloBucket : Bucket
, alloAmts : List (Amount v)
, alloCurrency : CurID
}
let Income =
{ incGross : Decimal
, incCurrency : CurID
, incWhen : DatePat
, incAccount : AcntID
, incPretax : List (Allocation Decimal)
, incTaxes : List Tax
, incPosttax : List (Allocation (Optional Decimal))
}
let Expense =
{ expFrom : AcntID
, expTo : AcntID
, expBucket : Bucket
, expAmounts : List TimeAmount
, expCurrency : CurID
}
let Budget = { income : List Income, expenses : List Expense }
in { CurID
, AcntID
, SqlConfig
, Currency
, Interval
, Global
, Gregorian
, GregorianM
, TimeUnit
, Weekday
, RepeatPat
, MDYPat
, ModPat
, WeekdayPat
, CronPat
, DatePat
, Decimal
, TxOpts
, Match
, MatchVal
, MatchYMD
, MatchDate
, MatchDesc
, MatchOther
, SplitNum
, Field
, FieldMap
, Split
, ExpSplit
, SplitText
, SplitCur
, SplitAcnt
, ToTx
, Import
, Manual
, Statement
, Bucket
, Budget
, Tax
}

View File

@ -2,72 +2,46 @@ let List/map =
https://prelude.dhall-lang.org/v21.1.0/List/map
sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
let T = ./Types.dhall
let nullSplit =
\(a : SplitAcnt) ->
\(c : SplitCur) ->
{ sAcnt = a, sCurrency = c, sValue = None SplitNum, sComment = "" }
\(a : T.SplitAcnt) ->
\(c : T.SplitCur) ->
T.ExpSplit::{ sAcnt = a, sCurrency = c }
let nullOpts =
{ toDate = "Date"
, toAmount = "Amount"
, toDesc = "Description"
, toOther = [] : List Text
, toDateFmt = "%0m/%0d/%Y"
, toAmountFmt = "([-+])?([0-9]+)\\.?([0-9]+)?"
}
let nullOpts = T.TxOpts::{=}
let nullVal =
{ mvSign = None Bool
, mvNum = None Natural
, mvDen = None Natural
, mvPrec = 2
}
let nullVal = T.MatchVal::{=}
let nullMatch =
{ mDate = None MatchDate
, mVal = nullVal
, mDesc = None MatchDesc
, mOther = [] : List MatchOther
, mTx = None ToTx
, mTimes = None Natural
, mPriority = +0
}
let nullMatch = T.Match::{=}
let nullCron =
{ cronWeekly = None WeekdayPat
, cronYear = None MDYPat
, cronMonth = None MDYPat
, cronDay = None MDYPat
}
let nullCron = T.CronPat::{=}
let nullMod =
\(by : Natural) ->
\(u : TimeUnit) ->
{ mpStart = None Gregorian
, mpBy = by
, mpUnit = u
, mpRepeats = None Natural
}
\(u : T.TimeUnit) ->
T.ModPat::{ mpBy = by, mpUnit = u }
let cron1 =
\(y : Natural) ->
\(m : Natural) ->
\(d : Natural) ->
DatePat.Cron
T.DatePat.Cron
( nullCron
// { cronYear = Some (MDYPat.Single y)
, cronMonth = Some (MDYPat.Single m)
, cronDay = Some (MDYPat.Single d)
// { cronYear = Some (T.MDYPat.Single y)
, cronMonth = Some (T.MDYPat.Single m)
, cronDay = Some (T.MDYPat.Single d)
}
)
let matchInf_ = nullMatch
let matchInf = \(x : ToTx) -> nullMatch // { mTx = Some x }
let matchInf = \(x : T.ToTx) -> nullMatch // { mTx = Some x }
let matchN_ = \(n : Natural) -> nullMatch // { mTimes = Some n }
let matchN = \(n : Natural) -> \(x : ToTx) -> matchInf x // { mTimes = Some n }
let matchN =
\(n : Natural) -> \(x : T.ToTx) -> matchInf x // { mTimes = Some n }
let match1_ = matchN_ 1
@ -81,65 +55,69 @@ let greg =
\(d : Natural) ->
{ gYear = y, gMonth = m, gDay = d }
let mY = \(y : Natural) -> MatchDate.On (MatchYMD.Y y)
let mY = \(y : Natural) -> T.MatchDate.On (T.MatchYMD.Y y)
let mYM =
\(y : Natural) -> \(m : Natural) -> MatchDate.On (MatchYMD.YM (gregM y m))
\(y : Natural) ->
\(m : Natural) ->
T.MatchDate.On (T.MatchYMD.YM (gregM y m))
let mYMD =
\(y : Natural) ->
\(m : Natural) ->
\(d : Natural) ->
MatchDate.On (MatchYMD.YMD (greg y m d))
T.MatchDate.On (T.MatchYMD.YMD (greg y m d))
let mRngY =
\(y : Natural) ->
\(r : Natural) ->
MatchDate.In { rStart = MatchYMD.Y y, rLen = r }
T.MatchDate.In { _1 = T.MatchYMD.Y y, _2 = r }
let mRngYM =
\(y : Natural) ->
\(m : Natural) ->
\(r : Natural) ->
MatchDate.In { rStart = MatchYMD.YM (gregM y m), rLen = r }
T.MatchDate.In { _1 = T.MatchYMD.YM (gregM y m), _2 = r }
let mRngYMD =
\(y : Natural) ->
\(m : Natural) ->
\(d : Natural) ->
\(r : Natural) ->
MatchDate.In { rStart = MatchYMD.YMD (greg y m d), rLen = r }
T.MatchDate.In { _1 = T.MatchYMD.YMD (greg y m d), _2 = r }
let PartSplit = { _1 : AcntID, _2 : Decimal, _3 : Text }
let PartSplit = { _1 : T.AcntID, _2 : T.Decimal, _3 : Text }
let partN =
\(c : SplitCur) ->
\(a : SplitAcnt) ->
\(c : T.SplitCur) ->
\(a : T.SplitAcnt) ->
\(comment : Text) ->
\(ss : List PartSplit) ->
let toSplit =
\(x : PartSplit) ->
nullSplit (SplitAcnt.ConstT x._1) c
// { sValue = Some (SplitNum.ConstN x._2), sComment = x._3 }
nullSplit (T.SplitAcnt.ConstT x._1) c
// { sValue = Some (T.SplitNum.ConstN x._2), sComment = x._3 }
in [ nullSplit a c // { sComment = comment } ]
# List/map PartSplit ExpSplit toSplit ss
# List/map PartSplit T.ExpSplit.Type toSplit ss
let part1 =
\(c : SplitCur) ->
\(a : SplitAcnt) ->
\(c : T.SplitCur) ->
\(a : T.SplitAcnt) ->
\(comment : Text) ->
partN c a comment ([] : List PartSplit)
let part1_ =
\(c : SplitCur) -> \(a : SplitAcnt) -> partN c a "" ([] : List PartSplit)
\(c : T.SplitCur) ->
\(a : T.SplitAcnt) ->
partN c a "" ([] : List PartSplit)
let dec =
\(s : Bool) ->
\(w : Natural) ->
\(d : Natural) ->
\(p : Natural) ->
{ whole = w, decimal = d, precision = p, sign = s } : Decimal
{ whole = w, decimal = d, precision = p, sign = s } : T.Decimal
let dec2 = \(s : Bool) -> \(w : Natural) -> \(d : Natural) -> dec s w d 2
@ -148,7 +126,7 @@ let d = dec2 True
let d_ = dec2 False
let addDay =
\(x : GregorianM) ->
\(x : T.GregorianM) ->
\(d : Natural) ->
{ gYear = x.gmYear, gMonth = x.gmMonth, gDay = d }

View File

@ -88,14 +88,24 @@ cronPatternMatches CronPat { cronWeekly = w
, cronMonth = m
, cronDay = d
} x =
mdyMaybe (y' - 2000) y && mdyMaybe m' m && mdyMaybe d' d && wdMaybe (dayOfWeek x) w
mdyMaybe (y' - 2000) y && mdyMaybe m' m && mdyMaybe d' d && wdMaybe (dayOfWeek_ x) w
where
testMaybe = maybe True
mdyMaybe z = testMaybe (`mdyPatternMatches` fromIntegral z)
wdMaybe z = testMaybe (`weekdayPatternMatches` z)
(y', m', d') = toGregorian x
weekdayPatternMatches :: WeekdayPat -> DayOfWeek -> Bool
dayOfWeek_ :: Day -> Weekday
dayOfWeek_ d = case dayOfWeek d of
Monday -> Mon
Tuesday -> Tue
Wednesday -> Wed
Thursday -> Thu
Friday -> Fri
Saturday -> Sat
Sunday -> Sun
weekdayPatternMatches :: WeekdayPat -> Weekday -> Bool
weekdayPatternMatches (OnDay x) = (== x)
weekdayPatternMatches (OnDays xs) = (`elem` xs)

View File

@ -69,7 +69,7 @@ parseTxRecord TxOpts {..} r = do
a <- parseRational toAmountFmt =<< r .: TE.encodeUtf8 toAmount
e <- r .: TE.encodeUtf8 toDesc
os <- M.fromList <$> mapM (\n -> (n, ) <$> r .: TE.encodeUtf8 n) toOther
d' <- parseTimeM True defaultTimeLocale toDateFmt d
d' <- parseTimeM True defaultTimeLocale (T.unpack toDateFmt) d
return $ Just $ TxRecord d' a e os
matchRecords :: [Match] -> [TxRecord] -> ([BalTx], [String], [Match])

View File

@ -2,6 +2,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
@ -20,11 +21,11 @@ import Data.Int
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Time
import Data.Yaml
import Database.Persist.Sql hiding (In, Statement)
import Dhall hiding (embed, maybe)
import Dhall.TH
import Language.Haskell.TH.Syntax (Lift)
@ -34,9 +35,33 @@ import Text.Read
-- | YAML CONFIG
-------------------------------------------------------------------------------
data SqlConfig = Sqlite T.Text |
Postgres -- TODO
deriving (Generic, FromDhall)
makeHaskellTypes
[ 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 "MatchDesc" "(./dhall/Types.dhall).MatchDesc"
, 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"
]
-------------------------------------------------------------------------------
-- | account tree
@ -67,19 +92,12 @@ type AccountRoot = AccountRoot_ AccountTree
-------------------------------------------------------------------------------
-- | curencies
data Currency = Currency
{ curSymbol :: !CurID
, curFullname :: !T.Text
}
deriving (Eq, Lift, Generic, Hashable, FromDhall)
deriving instance Eq Currency
deriving instance Lift Currency
deriving instance Hashable Currency
type CurID = T.Text
instance FromJSON Currency where
parseJSON = withObject "Currency" $ \o -> Currency
<$> o .: "symbol"
<*> o .: "desc"
-------------------------------------------------------------------------------
-- | DHALL CONFIG
-------------------------------------------------------------------------------
@ -89,7 +107,7 @@ data Config_ a = Config_
, budget :: !Budget
, currencies :: ![Currency]
, statements :: ![Statement]
, accounts :: a
, accounts :: !a
, sqlConfig :: !SqlConfig
}
deriving (Generic)
@ -112,100 +130,47 @@ unfix c@Config_ { accounts = a } = c { accounts = a' }
instance FromDhall a => FromDhall (Config_ a)
data Global = Global
{ budgetInterval :: !Interval
, statementInterval :: !Interval
}
deriving (Generic, FromDhall)
-------------------------------------------------------------------------------
-- | accounts
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)
type AcntID = T.Text
--------------------------------------------------------------------------------
-- | Time Patterns (for assigning when budget events will happen)
data Interval = Interval
{ intStart :: Maybe Gregorian
, intEnd :: Maybe Gregorian
}
deriving (Generic, FromDhall)
deriving instance Eq TimeUnit
deriving instance Hashable TimeUnit
data TimeUnit = Day | Week | Month | Year
deriving (Eq, Hashable, Generic, FromDhall)
deriving instance Eq Weekday
deriving instance Hashable Weekday
data WeekdayPat = OnDay !DayOfWeek | OnDays ![DayOfWeek]
deriving (Eq, Generic, FromDhall)
deriving instance Eq WeekdayPat
deriving instance Hashable WeekdayPat
instance Hashable WeekdayPat where
hashWithSalt s (OnDay d) = s `hashWithSalt` ("WPDay" :: T.Text)
`hashWithSalt` fromEnum d
hashWithSalt s (OnDays ds) = s `hashWithSalt` ("WPDays" :: T.Text)
`hashWithSalt` fromEnum <$> ds
deriving instance Eq RepeatPat
deriving instance Hashable RepeatPat
data RepeatPat = RepeatPat
{ rpStart :: !Natural
, rpBy :: !Natural
, rpRepeats :: Maybe Natural
}
deriving (Eq, Hashable, Generic, FromDhall)
deriving instance Eq MDYPat
deriving instance Hashable MDYPat
data MDYPat = Single !Natural
| Multi ![Natural]
| Repeat !RepeatPat
deriving (Eq, Hashable, Generic, FromDhall)
deriving instance Eq Gregorian
deriving instance Ord Gregorian
deriving instance Show Gregorian
deriving instance Hashable Gregorian
data Gregorian = Gregorian
{ gYear :: !Natural
, gMonth :: !Natural
, gDay :: !Natural
}
deriving (Show, Ord, Eq, Hashable, Generic, FromDhall)
deriving instance Eq GregorianM
deriving instance Ord GregorianM
deriving instance Show GregorianM
deriving instance Hashable GregorianM
data GregorianM = GregorianM
{ gmYear :: !Natural
, gmMonth :: !Natural
}
deriving (Show, Ord, Eq, Hashable, Generic, FromDhall)
deriving instance Eq ModPat
deriving instance Hashable ModPat
data ModPat = ModPat
{ mpStart :: Maybe Gregorian
, mpBy :: !Natural
, mpUnit :: !TimeUnit
, mpRepeats :: Maybe Natural
}
deriving (Eq, Hashable, Generic, FromDhall)
deriving instance Eq CronPat
deriving instance Hashable CronPat
data CronPat = CronPat
{ cronWeekly :: Maybe WeekdayPat
, cronYear :: Maybe MDYPat
, cronMonth :: Maybe MDYPat
, cronDay :: Maybe MDYPat
}
deriving (Eq, Hashable, Generic, FromDhall)
data DatePat = Cron !CronPat | Mod !ModPat
deriving (Eq, Hashable, Generic, FromDhall)
deriving instance Eq DatePat
deriving instance Hashable DatePat
--------------------------------------------------------------------------------
-- | Budget (projecting into the future)
@ -227,11 +192,8 @@ data Budget = Budget
}
deriving (Generic, FromDhall)
data Tax = Tax
{ taxAcnt :: !AcntID
, taxValue :: !Decimal
}
deriving (Eq, Hashable, Generic, FromDhall)
deriving instance Eq Tax
deriving instance Hashable Tax
data Amount v = Amount
{ amtValue :: !v
@ -246,8 +208,9 @@ data Allocation v = Allocation
}
deriving (Eq, Hashable, Generic, FromDhall)
data Bucket = Fixed | Investment | Savings | Guiltless
deriving (Show, Eq, Hashable, Generic, FromDhall)
deriving instance Eq Bucket
deriving instance Hashable Bucket
deriving instance Show Bucket
data TimeAmount = TimeAmount
{ taWhen :: !DatePat
@ -271,15 +234,7 @@ data Statement = StmtManual Manual
| StmtImport Import
deriving (Generic, FromDhall)
data Manual = Manual
{ manualDate :: !DatePat
, manualFrom :: !AcntID
, manualTo :: !AcntID
, manualValue :: !Decimal
, manualDesc :: !T.Text
, manualCurrency :: !CurID
}
deriving (Hashable, Generic, FromDhall)
deriving instance Hashable Manual
data Split a v c = Split
{ sAcnt :: !a
@ -312,25 +267,17 @@ data Import = Import
}
deriving (Hashable, Generic, FromDhall)
data MatchVal = MatchVal
{ mvSign :: Maybe Bool
, mvNum :: Maybe Natural
, mvDen :: Maybe Natural
, mvPrec :: !Natural
}
deriving (Show, Eq, Hashable, Generic, FromDhall)
deriving instance Eq MatchVal
deriving instance Hashable MatchVal
deriving instance Show MatchVal
data MatchYMD = Y !Natural | YM !GregorianM | YMD !Gregorian
deriving (Show, Eq, Hashable, Generic, FromDhall)
deriving instance Eq MatchYMD
deriving instance Hashable MatchYMD
deriving instance Show MatchYMD
data Range a = Range
{ rStart :: !a
, rLen :: !Natural
}
deriving (Show, Eq, Hashable, Generic, FromDhall)
data MatchDate = On !MatchYMD | In (Range MatchYMD)
deriving (Show, Eq, Hashable, Generic, FromDhall)
deriving instance Eq MatchDate
deriving instance Hashable MatchDate
deriving instance Show MatchDate
-- TODO this just looks silly...but not sure how to simplify it
instance Ord MatchYMD where
@ -346,14 +293,13 @@ instance Ord MatchYMD where
instance Ord MatchDate where
compare (On d) (On d') = compare d d'
compare (In (Range d r)) (In (Range d' r')) = compare d d' <> compare r r'
compare (On d) (In (Range d' _)) = compare d d' <> LT
compare (In (Range d _)) (On d') = compare d d' <> GT
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
data SplitNum = LookupN !T.Text
| ConstN !Decimal
| AmountN
deriving (Eq, Generic, Hashable, Show, FromDhall)
deriving instance Eq SplitNum
deriving instance Hashable SplitNum
deriving instance Show SplitNum
-- | the value of a field in split (text version)
-- can either be a raw (constant) value, a lookup from the record, or a map
@ -376,8 +322,9 @@ data Field k v = Field
type FieldMap k v = Field k (M.Map k v)
data MatchDesc = Re !T.Text | Exact !T.Text
deriving (Show, Eq, Hashable, Generic, FromDhall)
deriving instance Eq MatchDesc
deriving instance Show MatchDesc
deriving instance Hashable MatchDesc
data MatchOther = Desc (Field T.Text MatchDesc)
| Val (Field T.Text MatchVal)
@ -401,35 +348,16 @@ data Match = Match
}
deriving (Eq, Generic, Hashable, Show, FromDhall)
data TxRecord = TxRecord
{ trDate :: !Day
, trAmount :: !Rational
, trDesc :: !T.Text
, trOther :: M.Map T.Text T.Text
}
deriving (Show, Eq, Ord)
data TxOpts = TxOpts
{ toDate :: !T.Text
, toAmount :: !T.Text
, toDesc :: !T.Text
, toOther :: ![T.Text]
, toDateFmt :: !String
, toAmountFmt :: !T.Text
}
deriving (Show, Eq, Hashable, Generic, FromDhall)
deriving instance Eq TxOpts
deriving instance Hashable TxOpts
deriving instance Show TxOpts
--------------------------------------------------------------------------------
-- | Specialized dhall types
-- | hacky way to encode a rational
data Decimal = D
{ whole :: Natural
, decimal :: Natural
, precision :: Natural
, sign :: Bool
}
deriving (Generic, FromDhall, Hashable, Show, Eq)
deriving instance Eq Decimal
deriving instance Hashable Decimal
deriving instance Show Decimal
--------------------------------------------------------------------------------
-- | database cache types
@ -457,6 +385,33 @@ instance PersistField ConfigType where
-------------------------------------------------------------------------------
-- | 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
}
deriving (Show, Eq, Ord)
type Bounds = (Day, Day)
type MaybeBounds = (Maybe Day, Maybe Day)

View File

@ -47,7 +47,7 @@ compareDate (On md) x = case md of
-- this up
(y, m, d) = toGregorianI x
sY = y2k y
compareDate (In (Range md o)) x = case md of
compareDate (In md o) x = case md of
Y y' -> compareRange y' o sY
YM (GregorianM y' m') -> let s = toMonth y' m' in compareRange s o $ toMonth sY m
YMD (Gregorian y' m' d') ->
@ -246,9 +246,10 @@ evalExp r s = case s of
AmountN -> Just $ trAmount r
dec2Rat :: Decimal -> Rational
dec2Rat (D w d p s) = k * (fromIntegral w + (fromIntegral d % (10 ^ p)))
dec2Rat D {..} =
k * (fromIntegral whole + (fromIntegral decimal % (10 ^ precision)))
where
k = if s then 1 else -1
k = if sign then 1 else -1
acntPath2Text :: AcntPath -> T.Text
acntPath2Text (AcntPath t cs) = T.intercalate "/" (atName t : cs)