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

View File

@ -88,14 +88,24 @@ cronPatternMatches CronPat { cronWeekly = w
, cronMonth = m , cronMonth = m
, cronDay = d , cronDay = d
} x = } 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 where
testMaybe = maybe True testMaybe = maybe True
mdyMaybe z = testMaybe (`mdyPatternMatches` fromIntegral z) mdyMaybe z = testMaybe (`mdyPatternMatches` fromIntegral z)
wdMaybe z = testMaybe (`weekdayPatternMatches` z) wdMaybe z = testMaybe (`weekdayPatternMatches` z)
(y', m', d') = toGregorian x (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 (OnDay x) = (== x)
weekdayPatternMatches (OnDays xs) = (`elem` xs) weekdayPatternMatches (OnDays xs) = (`elem` xs)

View File

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

View File

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

View File

@ -47,7 +47,7 @@ compareDate (On md) x = case md of
-- this up -- this up
(y, m, d) = toGregorianI x (y, m, d) = toGregorianI x
sY = y2k y 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 Y y' -> compareRange y' o sY
YM (GregorianM y' m') -> let s = toMonth y' m' in compareRange s o $ toMonth sY m YM (GregorianM y' m') -> let s = toMonth y' m' in compareRange s o $ toMonth sY m
YMD (Gregorian y' m' d') -> YMD (Gregorian y' m' d') ->
@ -246,9 +246,10 @@ evalExp r s = case s of
AmountN -> Just $ trAmount r AmountN -> Just $ trAmount r
dec2Rat :: Decimal -> Rational 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 where
k = if s then 1 else -1 k = if sign then 1 else -1
acntPath2Text :: AcntPath -> T.Text acntPath2Text :: AcntPath -> T.Text
acntPath2Text (AcntPath t cs) = T.intercalate "/" (atName t : cs) acntPath2Text (AcntPath t cs) = T.intercalate "/" (atName t : cs)