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_virtual_postings          :: Posting_by_Account
  63  , transaction_balanced_virtual_postings :: Posting_by_Account
  64  , transaction_sourcepos                 :: SourcePos
  65  , transaction_status                    :: Status
  66  , transaction_tags                      :: Tag_by_Name
  67  } deriving (Data, Eq, Show, Typeable)
  68
  69 transaction :: Transaction
  70 transaction =
  71         Transaction
  72          { transaction_code = ""
  73          , transaction_comments_before = []
  74          , transaction_comments_after = []
  75          , transaction_dates = (Date.nil, [])
  76          , transaction_description = ""
  77          , transaction_postings = Data.Map.empty
  78          , transaction_virtual_postings = Data.Map.empty
  79          , transaction_balanced_virtual_postings = Data.Map.empty
  80          , transaction_sourcepos = initialPos ""
  81          , transaction_status = False
  82          , transaction_tags = Data.Map.empty
  83          }
  84
  85 type Transaction_by_Date
  86  = Data.Map.Map Date.UTC [Transaction]
  87
  88 -- | Return a 'Data.Map.Map' associating
  89 --   the given 'Transaction's with their respective 'Date'.
  90 transaction_by_Date :: [Transaction] -> Transaction_by_Date
  91 transaction_by_Date =
  92         Data.Map.fromListWith (flip (++)) .
  93         Data.List.map (\t -> (Date.to_UTC $ fst $ transaction_dates t, [t]))
  94
  95 -- * The 'Posting' type
  96
  97 data Posting
  98  =   Posting
  99  { posting_account   :: Account
 100  , posting_amounts   :: Amount.By_Unit
 101  , posting_comments  :: [Comment]
 102  , posting_dates     :: [Date]
 103  , posting_sourcepos :: SourcePos
 104  , posting_status    :: Bool
 105  , posting_tags      :: Tag_by_Name
 106  } deriving (Data, Eq, Show, Typeable)
 107
 108 data Posting_Type
 109  =   Posting_Type_Regular
 110  |   Posting_Type_Virtual
 111  |   Posting_Type_Virtual_Balanced
 112  deriving (Data, Eq, Read, Show, Typeable)
 113
 114 posting :: Account -> Posting
 115 posting acct =
 116         Posting
 117          { posting_account = acct
 118          , posting_amounts = Data.Map.empty
 119          , posting_comments = []
 120          , posting_dates = []
 121          , posting_status = False
 122          , posting_sourcepos = initialPos ""
 123          , posting_tags = Data.Map.empty
 124          }
 125
 126 instance Calc.Balance.Posting Posting
 127  where
 128         type Posting_Amount Posting = Amount
 129         type Posting_Unit   Posting = Amount.Unit
 130         posting_account = posting_account
 131         posting_amounts = posting_amounts
 132         posting_make acct amounts = (posting acct) { posting_amounts=amounts }
 133
 134 -- ** The 'Posting' mappings
 135
 136 type Posting_by_Account
 137  = Data.Map.Map Account [Posting]
 138
 139 type Posting_by_Amount_and_Account
 140  = Data.Map.Map Amount.By_Unit Posting_by_Account
 141
 142 type Posting_by_Signs_and_Account
 143  = Data.Map.Map Amount.Signs Posting_by_Account
 144
 145 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
 146 posting_by_Account :: [Posting] -> Posting_by_Account
 147 posting_by_Account =
 148         Data.Map.fromListWith (flip (++)) .
 149         Data.List.map
 150          (\p -> (posting_account p, [p]))
 151
 152 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
 153 posting_by_Amount_and_Account =
 154         Data.Map.foldlWithKey
 155          (flip (\acct ->
 156                 Data.List.foldl
 157                  (flip (\p ->
 158                         Data.Map.insertWith
 159                          (Data.Map.unionWith (++))
 160                          (posting_amounts p)
 161                          (Data.Map.singleton acct [p])))))
 162          Data.Map.empty
 163
 164 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
 165 posting_by_Signs_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                          (Amount.signs $ posting_amounts p)
 173                          (Data.Map.singleton acct [p])))))
 174          Data.Map.empty
 175
 176 -- * The 'Tag' type
 177
 178 type Tag = (Tag_Name, Tag_Value)
 179 type Tag_Name = Text
 180 type Tag_Value = Text
 181
 182 type Tag_by_Name = Data.Map.Map Tag_Name [Tag_Value]
 183
 184 -- | Return a 'Data.Map.Map' associating the 'Value's of the given 'Tag's with their respective 'Name'.
 185 tag_by_Name :: [Tag] -> Tag_by_Name
 186 tag_by_Name =
 187         Data.Map.fromListWith (flip (++)) .
 188         Data.List.map (\(n, v) -> (n, [v]))