diff --git a/dhall/Types.dhall b/dhall/Types.dhall new file mode 100644 index 0000000..cbd062d --- /dev/null +++ b/dhall/Types.dhall @@ -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 + } diff --git a/dhall/common.dhall b/dhall/common.dhall index 9414b45..b0131ab 100644 --- a/dhall/common.dhall +++ b/dhall/common.dhall @@ -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 } diff --git a/lib/Internal/Insert.hs b/lib/Internal/Insert.hs index 2152c1b..a9f98a6 100644 --- a/lib/Internal/Insert.hs +++ b/lib/Internal/Insert.hs @@ -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) diff --git a/lib/Internal/Statement.hs b/lib/Internal/Statement.hs index 6d36c14..4fb2f4b 100644 --- a/lib/Internal/Statement.hs +++ b/lib/Internal/Statement.hs @@ -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]) diff --git a/lib/Internal/Types.hs b/lib/Internal/Types.hs index bfce0ce..96afeee 100644 --- a/lib/Internal/Types.hs +++ b/lib/Internal/Types.hs @@ -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) diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs index 22692a4..521aa9b 100644 --- a/lib/Internal/Utils.hs +++ b/lib/Internal/Utils.hs @@ -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)