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         transaction_tags        = transaction_tags
  92
  93 type Transaction_by_Date
  94  = Data.Map.Map Date [Transaction]
  95
  96 -- | Return a 'Data.Map.Map' associating
  97 --   the given 'Transaction's with their respective 'Date'.
  98 transaction_by_Date :: [Transaction] -> Transaction_by_Date
  99 transaction_by_Date =
 100         Data.Map.fromListWith (flip (++)) .
 101         Data.List.map (\t -> (fst $ transaction_dates t, [t]))
 102
 103 -- * The 'Posting' type
 104
 105 data Posting
 106  =   Posting
 107  { posting_account   :: Account
 108  , posting_amounts   :: Map Amount.Unit Amount
 109  , posting_comments  :: [Comment]
 110  , posting_dates     :: [Date]
 111  , posting_sourcepos :: SourcePos
 112  , posting_status    :: Bool
 113  , posting_tags      :: Tag_by_Name
 114  } deriving (Data, Eq, Show, Typeable)
 115
 116 data Posting_Type
 117  =   Posting_Type_Regular
 118  |   Posting_Type_Virtual
 119  |   Posting_Type_Virtual_Balanced
 120  deriving (Data, Eq, Read, Show, Typeable)
 121
 122 posting :: Account -> Posting
 123 posting acct =
 124         Posting
 125          { posting_account = acct
 126          , posting_amounts = Data.Map.empty
 127          , posting_comments = []
 128          , posting_dates = []
 129          , posting_status = False
 130          , posting_sourcepos = initialPos ""
 131          , posting_tags = Data.Map.empty
 132          }
 133
 134 instance
 135  Balance.Posting Posting where
 136         type Posting_Amount Posting = Balance.Amount_Sum Amount
 137         posting_account = posting_account
 138         posting_amounts = Data.Map.map Balance.amount_sum . posting_amounts
 139         posting_set_amounts amounts p =
 140                 p { posting_amounts=Data.Map.map Balance.amount_sum_balance amounts }
 141
 142 instance Model.Filter.Posting Posting where
 143         type Posting_Amount Posting = Amount
 144         posting_account = posting_account
 145         posting_amounts = posting_amounts
 146
 147 -- ** The 'Posting' mappings
 148
 149 type Posting_by_Account
 150  = Data.Map.Map Account [Posting]
 151
 152 type Posting_by_Amount_and_Account
 153  = Data.Map.Map Amount.By_Unit Posting_by_Account
 154
 155 type Posting_by_Signs_and_Account
 156  = Data.Map.Map Amount.Signs Posting_by_Account
 157
 158 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
 159 posting_by_Account :: [Posting] -> Posting_by_Account
 160 posting_by_Account =
 161         Data.Map.fromListWith (flip (++)) .
 162         Data.List.map
 163          (\p -> (posting_account p, [p]))
 164
 165 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
 166 posting_by_Amount_and_Account =
 167         Data.Map.foldlWithKey
 168          (flip (\acct ->
 169                 Data.List.foldl
 170                  (flip (\p ->
 171                         Data.Map.insertWith
 172                          (Data.Map.unionWith (++))
 173                          (posting_amounts p)
 174                          (Data.Map.singleton acct [p])))))
 175          Data.Map.empty
 176
 177 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
 178 posting_by_Signs_and_Account =
 179         Data.Map.foldlWithKey
 180          (flip (\acct ->
 181                 Data.List.foldl
 182                  (flip (\p ->
 183                         Data.Map.insertWith
 184                          (Data.Map.unionWith (++))
 185                          (Amount.signs $ posting_amounts p)
 186                          (Data.Map.singleton acct [p])))))
 187          Data.Map.empty
 188
 189 -- * The 'Tag' type
 190
 191 type Tag = (Tag_Name, Tag_Value)
 192 type Tag_Name = Text
 193 type Tag_Value = Text
 194
 195 type Tag_by_Name = Data.Map.Map Tag_Name [Tag_Value]
 196
 197 -- | Return a 'Data.Map.Map' associating the 'Value's of the given 'Tag's with their respective 'Name'.
 198 tag_by_Name :: [Tag] -> Tag_by_Name
 199 tag_by_Name =
 200         Data.Map.fromListWith (flip (++)) .
 201         Data.List.map (\(n, v) -> (n, [v]))