pwncash/lib/Internal/Types.hs

{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DeriveLift         #-}
{-# LANGUAGE DeriveTraversable  #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeFamilies       #-}

module Internal.Types where

import           Data.Fix                   (Fix (..), foldFix)
import           Data.Functor.Foldable      (embed)
import qualified Data.Functor.Foldable.TH   as TH
import           Data.Hashable
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           Language.Haskell.TH.Syntax (Lift)

import           Text.Read

-------------------------------------------------------------------------------
-- | YAML CONFIG
-------------------------------------------------------------------------------

-------------------------------------------------------------------------------
-- | account tree

data AccountTree = Placeholder T.Text T.Text [AccountTree]
  | Account T.Text T.Text

TH.makeBaseFunctor ''AccountTree

deriving instance Generic (AccountTreeF a)
deriving instance FromDhall a => FromDhall (AccountTreeF a)

data AccountRoot_ a = AccountRoot_
  { arAssets      :: ![a]
  , arEquity      :: ![a]
  , arExpenses    :: ![a]
  , arIncome      :: ![a]
  , arLiabilities :: ![a]
  }
  deriving (Generic)

type AccountRootF = AccountRoot_ (Fix AccountTreeF)

deriving instance FromDhall AccountRootF

type AccountRoot = AccountRoot_ AccountTree

-------------------------------------------------------------------------------
-- | curencies

data Currency = Currency
  { curSymbol   :: !CurID
  , curFullname :: !T.Text
  }
  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
-------------------------------------------------------------------------------

data Config_ a = Config_
  { global     :: !Global
  , budget     :: !Budget
  , currencies :: ![Currency]
  , statements :: ![Statement]
  , accounts   :: a
  }
  deriving (Generic)

type ConfigF = Config_ AccountRootF

type Config = Config_ AccountRoot

unfix :: ConfigF -> Config
unfix c@Config_ { accounts = a } = c { accounts = a' }
  where
    a' = AccountRoot_
      { arAssets = unfixTree arAssets
      , arEquity = unfixTree arEquity
      , arExpenses = unfixTree arExpenses
      , arIncome = unfixTree arIncome
      , arLiabilities = unfixTree arLiabilities
      }
    unfixTree f = foldFix embed <$> f 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)

data TimeUnit = Day | Week | Month | Year
  deriving (Eq, Hashable, Generic, FromDhall)

data WeekdayPat = OnDay !DayOfWeek | OnDays ![DayOfWeek]
  deriving (Eq, Generic, FromDhall)

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

data RepeatPat = RepeatPat
  { rpStart   :: !Natural
  , rpBy      :: !Natural
  , rpRepeats :: Maybe Natural
  }
  deriving (Eq, Hashable, Generic, FromDhall)

data MDYPat = Single !Natural
  | Multi ![Natural]
  | Repeat !RepeatPat
  deriving (Eq, Hashable, Generic, FromDhall)

data Gregorian = Gregorian
  { gYear  :: !Natural
  , gMonth :: !Natural
  , gDay   :: !Natural
  }
  deriving (Show, Ord, Eq, Hashable, Generic, FromDhall)

data GregorianM = GregorianM
  { gmYear  :: !Natural
  , gmMonth :: !Natural
  }
  deriving (Show, Ord, Eq, Hashable, Generic, FromDhall)

data ModPat = ModPat
  { mpStart   :: Maybe Gregorian
  , mpBy      :: !Natural
  , mpUnit    :: !TimeUnit
  , mpRepeats :: Maybe Natural
  }
  deriving (Eq, Hashable, Generic, FromDhall)

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)

--------------------------------------------------------------------------------
-- | Budget (projecting into the future)

data Income = Income
  { incGross    :: !Decimal
  , incCurrency :: !CurID
  , incWhen     :: !DatePat
  , incAccount  :: !AcntID
  , incPretax   :: ![Allocation Decimal]
  , incTaxes    :: ![Tax]
  , incPosttax  :: ![Allocation (Maybe Decimal)]
  }
  deriving (Eq, Hashable, Generic, FromDhall)

data Budget = Budget
  { income   :: ![Income]
  , expenses :: ![Expense]
  }
  deriving (Generic, FromDhall)

data Tax = Tax
  { taxAcnt  :: !AcntID
  , taxValue :: !Decimal
  }
  deriving (Eq, Hashable, Generic, FromDhall)

data Amount v = Amount
  { amtValue :: !v
  , amtDesc  :: !T.Text
  } deriving (Functor, Foldable, Traversable, Eq, Hashable, Generic, FromDhall)

data Allocation v = Allocation
  { alloPath     :: !AcntID
  , alloBucket   :: !Bucket
  , alloAmts     :: ![Amount v]
  , alloCurrency :: !CurID
  }
  deriving (Eq, Hashable, Generic, FromDhall)

data Bucket = Fixed | Investment | Savings | Guiltless
  deriving (Show, Eq, Hashable, Generic, FromDhall)

data TimeAmount = TimeAmount
  { taWhen :: !DatePat
  , taAmt  :: Amount Decimal
  }
  deriving (Eq, Hashable, Generic, FromDhall)

data Expense = Expense
  { expFrom     :: !AcntID
  , expTo       :: !AcntID
  , expBucket   :: !Bucket
  , expAmounts  :: ![TimeAmount]
  , expCurrency :: !CurID
  }
  deriving (Eq, Hashable, Generic, FromDhall)

--------------------------------------------------------------------------------
-- | Statements (data from the past)

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)

data Split a v c = Split
  { sAcnt     :: !a
  , sValue    :: !v
  , sCurrency :: !c
  , sComment  :: !T.Text
  }
  deriving (Eq, Generic, Hashable, Show, FromDhall)

type ExpSplit = Split SplitAcnt (Maybe SplitNum) SplitCur

data Tx s = Tx
  { txDescr  :: !T.Text
  , txDate   :: !Day
  , txTags   :: ![T.Text]
  , txSplits :: ![s]
  }
  deriving (Generic)

type ExpTx = Tx ExpSplit

instance FromDhall ExpTx where

data Import = Import
  { impPaths     :: ![FilePath]
  , impMatches   :: ![Match]
  , impDelim     :: !Word
  , impTxOpts    :: !TxOpts
  , impSkipLines :: !Natural
  }
  deriving (Hashable, Generic, FromDhall)

data MatchVal = MatchVal
  { mvSign :: Maybe Bool
  , mvNum  :: Maybe Natural
  , mvDen  :: Maybe Natural
  , mvPrec :: !Natural
  }
  deriving (Show, Eq, Hashable, Generic, FromDhall)

data MatchYMD = Y !Natural | YM !GregorianM | YMD !Gregorian
  deriving (Show, Eq, Hashable, Generic, FromDhall)

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)

-- TODO this just looks silly...but not sure how to simplify it
instance Ord MatchYMD where
  compare (Y y) (Y y')           = compare y y'
  compare (YM g) (YM g')         = compare g g'
  compare (YMD g) (YMD g')       = compare g g'
  compare (Y y) (YM g)           = compare y (gmYear g) <> LT
  compare (Y y) (YMD g)          = compare y (gYear g) <> LT
  compare (YM g) (Y y')        = compare (gmYear g) y' <> GT
  compare (YMD g) (Y y')     = compare (gYear g) y' <> GT
  compare (YM (GregorianM y m)) (YMD (Gregorian y' m' _)) = compare (y, m) (y', m') <> LT
  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

data SplitNum = LookupN !T.Text
  | ConstN !Decimal
  | AmountN
  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
-- between the lookup and some other value
data SplitText t = ConstT !t
  | LookupT !T.Text
  | MapT (FieldMap T.Text t)
  | Map2T (FieldMap (T.Text, T.Text) t)
  deriving (Eq, Generic, Hashable, Show, FromDhall)

type SplitCur = SplitText CurID

type SplitAcnt = SplitText AcntID

data Field k v = Field
  { fKey :: !k
  , fVal :: !v
  }
  deriving (Show, Eq, Hashable, Generic, FromDhall)

type FieldMap k v = Field k (M.Map k v)

data MatchDesc = Re !T.Text | Exact !T.Text
  deriving (Show, Eq, Hashable, Generic, FromDhall)

data MatchOther = Desc (Field T.Text MatchDesc)
  | Val (Field T.Text MatchVal)
  deriving (Show, Eq, Hashable, Generic, FromDhall)

data ToTx = ToTx
  { ttCurrency :: !SplitCur
  , ttPath     :: !SplitAcnt
  , ttSplit    :: ![ExpSplit]
  }
  deriving (Eq, Generic, Hashable, Show, FromDhall)

data Match = Match
  { mDate     :: Maybe MatchDate
  , mVal      :: MatchVal
  , mDesc     :: Maybe MatchDesc
  , mOther    :: ![MatchOther]
  , mTx       :: Maybe ToTx
  , mTimes    :: Maybe Natural
  , mPriority :: !Integer
  }
  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)

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

--------------------------------------------------------------------------------
-- | database cache types

data ConfigHashes = ConfigHashes
  { chIncome  :: ![Int]
  , chExpense :: ![Int]
  , chManual  :: ![Int]
  , chImport  :: ![Int]
  }

data ConfigType = CTIncome | CTExpense | CTManual | CTImport
  deriving (Eq, Show, Read, Enum)

instance PersistFieldSql ConfigType where
  sqlType _ = SqlString

instance PersistField ConfigType where
  toPersistValue = PersistText . T.pack . show
  -- TODO these error messages *might* be good enough?
  fromPersistValue (PersistText v) =
    maybe (Left $ "could not parse: " <> v) Right $ readMaybe $ T.unpack v
  fromPersistValue _ = Left "wrong type"

-------------------------------------------------------------------------------
-- | misc

type Bounds = (Day, Day)

type MaybeBounds = (Maybe Day, Maybe Day)

data Keyed a = Keyed
  { kKey :: !Int64
  , kVal :: !a
  }
  deriving (Eq, Show, Functor)

data Tree a = Branch !a ![Tree a] | Leaf !a deriving Show

data AcntSign = Credit | Debit
  deriving (Show)

sign2Int :: AcntSign -> Int
sign2Int Debit  = 1
sign2Int Credit = 1

accountSign :: AcntType -> AcntSign
accountSign AssetT     = Debit
accountSign ExpenseT   = Debit
accountSign IncomeT    = Credit
accountSign LiabilityT = Credit
accountSign EquityT    = Credit

type RawAmount = Amount (Maybe Rational)

type BalAmount = Amount Rational

type RawAllocation = Allocation (Maybe Rational)

type BalAllocation = Allocation Rational

type RawSplit = Split AcntID (Maybe Rational) CurID

type BalSplit = Split AcntID Rational CurID

type RawTx = Tx RawSplit
type BalTx = Tx BalSplit