WIP use dhall for types

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
+    }

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) ->
+      \(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 =
       \(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 =
       \(y : Natural) ->
       \(m : Natural) ->
       \(d : Natural) ->
-        DatePat.Cron
+        T.DatePat.Cron
           (     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 = \(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) ->
+      \(c : T.SplitCur) ->
-      \(a : SplitAcnt) ->
+      \(a : T.SplitAcnt) ->
       \(comment : Text) ->
       \(ss : List PartSplit) ->
         let toSplit =
               \(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 } ]
-            # List/map PartSplit ExpSplit toSplit ss
+            # List/map PartSplit T.ExpSplit.Type toSplit ss
 
 let part1 =
-      \(c : SplitCur) ->
+      \(c : T.SplitCur) ->
-      \(a : SplitAcnt) ->
+      \(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 }
 

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)
 

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])

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 |
+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
@@ -67,19 +92,12 @@ type AccountRoot = AccountRoot_ AccountTree
 -------------------------------------------------------------------------------
 -- | 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
 
-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
+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)
@@ -227,11 +192,8 @@ data Budget = Budget
   }
   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
   { amtValue :: !v
@@ -246,8 +208,9 @@ data Allocation v = Allocation
   }
   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
   { taWhen :: !DatePat
@@ -271,15 +234,7 @@ data Statement = StmtManual Manual
   | StmtImport Import
   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
   { sAcnt     :: !a
@@ -312,25 +267,17 @@ data Import = Import
   }
   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
 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 (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)
 -- 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 instance Eq MatchDesc
-  deriving (Show, Eq, Hashable, Generic, FromDhall)
+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
+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
 
--- | 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
@@ -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)

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)