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