lib/Hcompta/Format/Ledger.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE NamedFieldPuns #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE TypeFamilies #-}
   5 module Hcompta.Format.Ledger where
   6
   7 import           Data.Data (Data(..))
   8 import           Data.Typeable (Typeable)
   9 import           Text.Parsec.Pos (SourcePos, initialPos)
  10 import qualified Data.Map.Strict as Data.Map
  11 import           Data.Map.Strict (Map)
  12 import qualified Data.List as Data.List
  13 import qualified Data.Time.Clock       as Time
  14 import qualified Data.Time.Clock.POSIX as Time
  15
  16 import           Hcompta.Lib.Parsec ()
  17 import qualified Hcompta.Calc.Balance as Balance
  18 import           Hcompta.Model.Date (Date)
  19 import qualified Hcompta.Model.Date as Date
  20 import           Hcompta.Model.Account (Account)
  21 -- import qualified Hcompta.Model.Account as Account
  22 import           Hcompta.Model.Amount (Amount)
  23 import qualified Hcompta.Model.Amount as Amount
  24 import qualified Hcompta.Model.Filter as Model.Filter
  25 import           Data.Text (Text)
  26
  27 type Code = Text
  28 type Description = Text
  29 type Status = Bool
  30 type Comment = Text
  31
  32 -- * The 'Journal' type
  33
  34 data Journal
  35  =   Journal
  36  { journal_file           :: FilePath
  37  , journal_includes       :: [Journal]
  38  , journal_last_read_time :: Time.UTCTime
  39  , journal_transactions   :: Transaction_by_Date
  40  , journal_unit_styles    :: Data.Map.Map Amount.Unit Amount.Style
  41  } deriving (Data, Eq, Show, Typeable)
  42
  43 journal :: Journal
  44 journal =
  45         Journal
  46          { journal_file = ""
  47          , journal_includes = []
  48          , journal_last_read_time = Time.posixSecondsToUTCTime 0
  49          , journal_transactions = Data.Map.empty
  50          , journal_unit_styles = Data.Map.empty
  51          }
  52
  53 -- * The 'Transaction' type
  54
  55 data Transaction
  56  =   Transaction
  57  { transaction_code                      :: Code
  58  , transaction_comments_before           :: [Comment]
  59  , transaction_comments_after            :: [Comment]
  60  , transaction_dates                     :: (Date, [Date])
  61  , transaction_description               :: Description
  62  , transaction_postings                  :: Posting_by_Account
  63  , transaction_virtual_postings          :: Posting_by_Account
  64  , transaction_balanced_virtual_postings :: Posting_by_Account
  65  , transaction_sourcepos                 :: SourcePos
  66  , transaction_status                    :: Status
  67  , transaction_tags                      :: Tag_by_Name
  68  } deriving (Data, Eq, Show, Typeable)
  69
  70 transaction :: Transaction
  71 transaction =
  72         Transaction
  73          { transaction_code = ""
  74          , transaction_comments_before = []
  75          , transaction_comments_after = []
  76          , transaction_dates = (Date.nil, [])
  77          , transaction_description = ""
  78          , transaction_postings = Data.Map.empty
  79          , transaction_virtual_postings = Data.Map.empty
  80          , transaction_balanced_virtual_postings = Data.Map.empty
  81          , transaction_sourcepos = initialPos ""
  82          , transaction_status = False
  83          , transaction_tags = Data.Map.empty
  84          }
  85
  86 instance Model.Filter.Transaction Transaction where
  87         type Transaction_Posting Transaction = Posting
  88         transaction_date        = fst . transaction_dates
  89         transaction_description = transaction_description
  90         transaction_postings    = transaction_postings
  91
  92 type Transaction_by_Date
  93  = Data.Map.Map Date.UTC [Transaction]
  94
  95 -- | Return a 'Data.Map.Map' associating
  96 --   the given 'Transaction's with their respective 'Date'.
  97 transaction_by_Date :: [Transaction] -> Transaction_by_Date
  98 transaction_by_Date =
  99         Data.Map.fromListWith (flip (++)) .
 100         Data.List.map (\t -> (Date.to_UTC $ fst $ transaction_dates t, [t]))
 101
 102 -- * The 'Posting' type
 103
 104 data Posting
 105  =   Posting
 106  { posting_account   :: Account
 107  , posting_amounts   :: Map Amount.Unit Amount
 108  , posting_comments  :: [Comment]
 109  , posting_dates     :: [Date]
 110  , posting_sourcepos :: SourcePos
 111  , posting_status    :: Bool
 112  , posting_tags      :: Tag_by_Name
 113  } deriving (Data, Eq, Show, Typeable)
 114
 115 data Posting_Type
 116  =   Posting_Type_Regular
 117  |   Posting_Type_Virtual
 118  |   Posting_Type_Virtual_Balanced
 119  deriving (Data, Eq, Read, Show, Typeable)
 120
 121 posting :: Account -> Posting
 122 posting acct =
 123         Posting
 124          { posting_account = acct
 125          , posting_amounts = Data.Map.empty
 126          , posting_comments = []
 127          , posting_dates = []
 128          , posting_status = False
 129          , posting_sourcepos = initialPos ""
 130          , posting_tags = Data.Map.empty
 131          }
 132
 133 instance
 134  Balance.Posting Posting where
 135         type Posting_Amount Posting = Balance.Amount_Sum Amount
 136         posting_account = posting_account
 137         posting_amounts = Data.Map.map Balance.amount_sum . posting_amounts
 138         posting_set_amounts amounts p =
 139                 p { posting_amounts=Data.Map.map Balance.amount_sum_balance amounts }
 140
 141 instance Model.Filter.Posting Posting where
 142         type Posting_Amount Posting = Amount
 143         posting_account = posting_account
 144         posting_amounts = posting_amounts
 145
 146 -- ** The 'Posting' mappings
 147
 148 type Posting_by_Account
 149  = Data.Map.Map Account [Posting]
 150
 151 type Posting_by_Amount_and_Account
 152  = Data.Map.Map Amount.By_Unit Posting_by_Account
 153
 154 type Posting_by_Signs_and_Account
 155  = Data.Map.Map Amount.Signs Posting_by_Account
 156
 157 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
 158 posting_by_Account :: [Posting] -> Posting_by_Account
 159 posting_by_Account =
 160         Data.Map.fromListWith (flip (++)) .
 161         Data.List.map
 162          (\p -> (posting_account p, [p]))
 163
 164 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
 165 posting_by_Amount_and_Account =
 166         Data.Map.foldlWithKey
 167          (flip (\acct ->
 168                 Data.List.foldl
 169                  (flip (\p ->
 170                         Data.Map.insertWith
 171                          (Data.Map.unionWith (++))
 172                          (posting_amounts p)
 173                          (Data.Map.singleton acct [p])))))
 174          Data.Map.empty
 175
 176 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
 177 posting_by_Signs_and_Account =
 178         Data.Map.foldlWithKey
 179          (flip (\acct ->
 180                 Data.List.foldl
 181                  (flip (\p ->
 182                         Data.Map.insertWith
 183                          (Data.Map.unionWith (++))
 184                          (Amount.signs $ posting_amounts p)
 185                          (Data.Map.singleton acct [p])))))
 186          Data.Map.empty
 187
 188 -- * The 'Tag' type
 189
 190 type Tag = (Tag_Name, Tag_Value)
 191 type Tag_Name = Text
 192 type Tag_Value = Text
 193
 194 type Tag_by_Name = Data.Map.Map Tag_Name [Tag_Value]
 195
 196 -- | Return a 'Data.Map.Map' associating the 'Value's of the given 'Tag's with their respective 'Name'.
 197 tag_by_Name :: [Tag] -> Tag_by_Name
 198 tag_by_Name =
 199         Data.Map.fromListWith (flip (++)) .
 200         Data.List.map (\(n, v) -> (n, [v]))