WIP use dhall for types
This commit is contained in:
parent
68e4ce36ca
commit
5e46efff9e
|
|
@ -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
|
||||
}
|
||||
|
|
@ -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 }
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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])
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -345,15 +292,14 @@ instance Ord MatchYMD where
|
|||
compare (YMD (Gregorian y m _)) (YM (GregorianM y' m')) = compare (y, m) (y', m') <> GT
|
||||
|
||||
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 (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
|
||||
|
||||
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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue