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
  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
  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.nil
  81          , transaction_virtual_postings = Data.Map.empty
  82          , transaction_balanced_virtual_postings = Data.Map.empty
  83          , transaction_balanced_virtual_postings_balance = Calc.Balance.nil
  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         posting_account = posting_account
 134         posting_amounts = posting_amounts
 135         posting_set_amounts amounts p = p { posting_amounts=amounts }
 136
 137 -- ** The 'Posting' mappings
 138
 139 type Posting_by_Account
 140  = Data.Map.Map Account [Posting]
 141
 142 type Posting_by_Amount_and_Account
 143  = Data.Map.Map Amount.By_Unit Posting_by_Account
 144
 145 type Posting_by_Signs_and_Account
 146  = Data.Map.Map Amount.Signs Posting_by_Account
 147
 148 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
 149 posting_by_Account :: [Posting] -> Posting_by_Account
 150 posting_by_Account =
 151         Data.Map.fromListWith (flip (++)) .
 152         Data.List.map
 153          (\p -> (posting_account p, [p]))
 154
 155 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
 156 posting_by_Amount_and_Account =
 157         Data.Map.foldlWithKey
 158          (flip (\acct ->
 159                 Data.List.foldl
 160                  (flip (\p ->
 161                         Data.Map.insertWith
 162                          (Data.Map.unionWith (++))
 163                          (posting_amounts p)
 164                          (Data.Map.singleton acct [p])))))
 165          Data.Map.empty
 166
 167 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
 168 posting_by_Signs_and_Account =
 169         Data.Map.foldlWithKey
 170          (flip (\acct ->
 171                 Data.List.foldl
 172                  (flip (\p ->
 173                         Data.Map.insertWith
 174                          (Data.Map.unionWith (++))
 175                          (Amount.signs $ posting_amounts p)
 176                          (Data.Map.singleton acct [p])))))
 177          Data.Map.empty
 178
 179 -- * The 'Tag' type
 180
 181 type Tag = (Tag_Name, Tag_Value)
 182 type Tag_Name = Text
 183 type Tag_Value = Text
 184
 185 type Tag_by_Name = Data.Map.Map Tag_Name [Tag_Value]
 186
 187 -- | Return a 'Data.Map.Map' associating the 'Value's of the given 'Tag's with their respective 'Name'.
 188 tag_by_Name :: [Tag] -> Tag_by_Name
 189 tag_by_Name =
 190         Data.Map.fromListWith (flip (++)) .
 191         Data.List.map (\(n, v) -> (n, [v]))