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