ledger/Hcompta/Format/Ledger.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE MultiParamTypeClasses #-}
   4 {-# LANGUAGE NamedFieldPuns #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 {-# LANGUAGE TupleSections #-}
   7 {-# LANGUAGE TypeFamilies #-}
   8 {-# OPTIONS_GHC -fno-warn-orphans #-}
   9 module Hcompta.Format.Ledger
  10  ( module Hcompta.Format.Ledger
  11  , module Hcompta.Format.Ledger.Amount
  12  , module Hcompta.Format.Ledger.Unit
  13  , module Hcompta.Format.Ledger.Quantity
  14  ) where
  15
  16 -- import           Control.Applicative (Const(..))
  17 import           Control.DeepSeq (NFData(..))
  18 import           Data.Bool
  19 import           Data.Data (Data(..))
  20 import           Data.Eq (Eq(..))
  21 import           Data.Function (on)
  22 import           Data.Functor (Functor(..))
  23 import           Data.Functor.Compose (Compose(..))
  24 import qualified Data.List as List
  25 import           Data.List.NonEmpty (NonEmpty(..))
  26 import           Data.Map.Strict (Map)
  27 import qualified Data.Map.Strict as Map
  28 import           Data.Maybe (Maybe(..))
  29 import           Data.Monoid (Monoid(..))
  30 import           Data.Ord (Ord(..))
  31 import           Data.Text (Text)
  32 import           Data.Tuple (fst, uncurry)
  33 import           Data.Typeable (Typeable)
  34 import           Prelude (($), (.), FilePath, Num(..), flip, seq, undefined)
  35 import           Text.Parsec.Pos (SourcePos, initialPos)
  36 import           Text.Show (Show)
  37
  38 import qualified Hcompta.Account as Account
  39 -- import qualified Hcompta.Amount as Amount
  40 -- import           Hcompta.Balance (Balance(..))
  41 import qualified Hcompta.Balance as Balance
  42 import qualified Hcompta.Chart as Chart
  43 import           Hcompta.Date (Date)
  44 import qualified Hcompta.Date as Date
  45 import qualified Hcompta.Filter as Filter
  46 -- import           Hcompta.GL (GL(..))
  47 import qualified Hcompta.GL as GL
  48 import qualified Hcompta.Journal as Journal
  49 -- import           Hcompta.Lib.Consable
  50 import           Hcompta.Lib.Parsec ()
  51 import           Hcompta.Lib.Regex (Regex)
  52 -- import qualified Hcompta.Quantity as Quantity
  53 import qualified Hcompta.Polarize as Polarize
  54 import qualified Hcompta.Posting as Posting
  55 import qualified Hcompta.Stats as Stats
  56 import qualified Hcompta.Tag as Tag
  57
  58 import           Hcompta.Format.Ledger.Amount
  59 import           Hcompta.Format.Ledger.Quantity
  60 import           Hcompta.Format.Ledger.Unit
  61
  62 -- * Type 'Account'
  63
  64 type Account_Section = Text
  65 type Account = NonEmpty Account_Section
  66 account :: Account_Section -> [Account_Section] -> Account
  67 account = (:|)
  68
  69 -- ** Type 'Joker'
  70
  71 type Account_Joker
  72  = [Account_Joker_Section]
  73 data Account_Joker_Section
  74  =   Account_Joker_Any
  75  |   Account_Joker_Section Text
  76  deriving (Data, Eq, Show, Typeable)
  77
  78 -- ** Type 'Pattern'
  79
  80 data Account_Pattern
  81  =   Account_Pattern_Exact Account
  82  |   Account_Pattern_Joker Account_Joker
  83  |   Account_Pattern_Regex Regex
  84  deriving (Show, Typeable)
  85
  86 -- * Type 'Chart'
  87
  88 type Chart = Chart.Chart Account
  89
  90 data Chart_With x
  91  =   Chart_With Chart x
  92  deriving (Data, Show)
  93 chart :: Chart_With t -> Chart
  94 chart (Chart_With c _) = c
  95 instance Account.Account a
  96  => Account.Account    (Chart_With a) where
  97         type Account_Section (Chart_With a) = Account.Account_Section a
  98         account_path = Account.account_path . with_chart
  99 instance Eq a => Eq (Chart_With a) where
 100         (==) = (==) `on` with_chart
 101 instance Ord a => Ord (Chart_With a) where
 102         compare = compare `on` with_chart
 103 instance Monoid a => Monoid (Chart_With a) where
 104         mempty = Chart_With mempty mempty
 105         mappend (Chart_With xc xt) (Chart_With yc yt) = Chart_With (mappend xc yc) (mappend xt yt)
 106 instance NFData x => NFData (Chart_With x) where
 107         rnf (Chart_With c x) = rnf c `seq` rnf x
 108
 109 with_chart :: Chart_With t -> t
 110 with_chart (Chart_With _ t) = t
 111
 112 -- * Type 'Posting'
 113
 114 data Posting
 115  =   Posting
 116  { posting_account   :: Account
 117  , posting_amounts   :: Map Unit Quantity
 118  , posting_comments  :: [Comment]
 119  , posting_dates     :: [Date]
 120  , posting_sourcepos :: SourcePos
 121  , posting_status    :: Bool
 122  , posting_tags      :: Tag.Tags
 123  } deriving (Data, Eq, Show, Typeable)
 124 instance NFData Posting where
 125         rnf
 126          Posting
 127          { posting_account
 128          , posting_amounts
 129          , posting_comments
 130          , posting_dates
 131          -- , posting_sourcepos
 132          , posting_status
 133          , posting_tags
 134          } =
 135                 rnf posting_account `seq`
 136                 rnf posting_amounts `seq`
 137                 rnf posting_comments `seq`
 138                 rnf posting_dates `seq`
 139                 -- rnf posting_sourcepos `seq`
 140                 rnf posting_status `seq`
 141                 rnf posting_tags
 142
 143 instance Filter.Account (Chart_With Account) where
 144         account_path = with_chart
 145         account_tags (Chart_With c a) = Chart.account_tags a c
 146
 147 posting :: Account -> Posting
 148 posting acct =
 149         Posting
 150          { posting_account   = acct
 151          , posting_amounts   = mempty
 152          , posting_comments  = mempty
 153          , posting_dates     = mempty
 154          , posting_status    = False
 155          , posting_sourcepos = initialPos ""
 156          , posting_tags      = mempty
 157          }
 158
 159 map_Postings_by_Account :: [Posting] -> Map Account [Posting]
 160 map_Postings_by_Account =
 161         Map.fromListWith (flip mappend) .
 162         List.map (\p -> (posting_account p, [p]))
 163
 164 instance Posting.Posting Posting where
 165         type Posting_Account   Posting = Account
 166         type Posting_Amount    Posting = Amount
 167         type Posting_Amounts   Posting = []
 168         posting_account = posting_account
 169         posting_amounts = List.map (uncurry Amount) . Map.toList . posting_amounts
 170
 171 instance Posting.Posting (Chart_With Posting) where
 172         type Posting_Account   (Chart_With Posting) = Chart_With Account
 173         type Posting_Amount    (Chart_With Posting) = Posting.Posting_Amount  Posting
 174         type Posting_Amounts   (Chart_With Posting) = Posting.Posting_Amounts Posting
 175         posting_account (Chart_With c p) = Chart_With c $ Posting.posting_account p
 176         posting_amounts = Posting.posting_amounts . with_chart
 177
 178 instance Balance.Posting Posting where
 179         type Posting_Account   Posting = Account
 180         type Posting_Quantity  Posting = Polarize.Polarized Quantity
 181         type Posting_Unit      Posting = Unit
 182         posting_account = posting_account
 183         posting_amounts = Map.map Polarize.polarize . posting_amounts
 184         posting_set_amounts amounts p =
 185                 p { posting_amounts=Map.map Polarize.depolarize amounts }
 186
 187 instance Balance.Posting (Chart_With Posting) where
 188         type Posting_Account   (Chart_With Posting) = Account
 189         type Posting_Quantity  (Chart_With Posting) = Balance.Posting_Quantity Posting
 190         type Posting_Unit      (Chart_With Posting) = Balance.Posting_Unit     Posting
 191         posting_account = posting_account . with_chart
 192         posting_amounts = Map.map Polarize.polarize . posting_amounts . with_chart
 193         posting_set_amounts amounts (Chart_With c p) =
 194                 Chart_With c p{ posting_amounts=Map.map Polarize.depolarize amounts }
 195
 196 instance Filter.Posting (Chart_With Posting) where
 197         posting_type = undefined
 198          -- NOTE: the posting_type will be given to Filter.test
 199          --       through instance Posting p => Posting (Posting_Typed p)
 200          --       by Filter.transaction_postings
 201          --       and Filter.transaction_postings_virtual
 202
 203 instance GL.Posting     Posting where
 204         type Posting_Account  Posting = Account
 205         type Posting_Quantity Posting = Map Unit (Polarize.Polarized Quantity)
 206         posting_account  = posting_account
 207         posting_quantity = Map.map Polarize.polarize . posting_amounts
 208
 209 instance GL.Posting     (Chart_With Posting) where
 210         type Posting_Account  (Chart_With Posting) = Account
 211         type Posting_Quantity (Chart_With Posting) = GL.Posting_Quantity Posting
 212         posting_account  = GL.posting_account  . with_chart
 213         posting_quantity = GL.posting_quantity . with_chart
 214
 215 instance Stats.Posting  Posting where
 216         type Posting_Account  Posting = Account
 217         type Posting_Quantity Posting = Quantity
 218         type Posting_Unit     Posting = Unit
 219         posting_account = posting_account
 220         posting_amounts = posting_amounts
 221
 222 -- ** Type 'Posting_Type'
 223
 224 data Posting_Type
 225  =   Posting_Type_Regular
 226  |   Posting_Type_Virtual
 227  |   Posting_Type_Virtual_Balanced
 228  deriving (Data, Eq, Show, Typeable)
 229
 230 data Posting_Typed posting
 231  =   Posting_Typed Posting_Type posting
 232  deriving (Data, Eq, Show)
 233
 234 {-
 235 -- ** 'Posting' mappings
 236
 237 type Posting_by_Account
 238  = Map Account [Posting]
 239
 240 type Posting_by_Amount_and_Account
 241  = Map (Map Unit Amount) Posting_by_Account
 242
 243 type Posting_by_Signs_and_Account
 244  = Map Signs Posting_by_Account
 245
 246 -- | Return a Data.'Map.Map' associating the given 'Posting's with their respective 'Account'.
 247 posting_by_Account :: [Posting] -> Posting_by_Account
 248 posting_by_Account =
 249         Map.fromListWith (flip mappend) .
 250         Data.List.map
 251          (\p -> (posting_account p, [p]))
 252
 253 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
 254 posting_by_Amount_and_Account =
 255         Map.foldlWithKey
 256          (flip (\acct ->
 257                 Data.List.foldl'
 258                  (flip (\p ->
 259                         Map.insertWith
 260                          (Map.unionWith mappend)
 261                          (posting_amounts p)
 262                          (Map.singleton acct [p])))))
 263          mempty
 264
 265 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
 266 posting_by_Signs_and_Account =
 267         Map.foldlWithKey
 268          (flip (\acct ->
 269                 Data.List.foldl'
 270                  (flip (\p ->
 271                         Map.insertWith
 272                          (Map.unionWith mappend)
 273                          (signs $ posting_amounts p)
 274                          (Map.singleton acct [p])))))
 275          mempty
 276 -}
 277
 278 -- * Type 'Transaction'
 279
 280 type Code        = Text
 281 type Description = Text
 282 type Status      = Bool
 283 type Comment     = Text
 284
 285 data Transaction
 286  =   Transaction
 287  { transaction_code                      :: Code
 288  , transaction_comments_before           :: [Comment]
 289  , transaction_comments_after            :: [Comment]
 290  , transaction_dates                     :: (Date, [Date])
 291  , transaction_description               :: Description
 292  , transaction_postings                  :: Map Account [Posting]
 293  , transaction_virtual_postings          :: Map Account [Posting]
 294  , transaction_balanced_virtual_postings :: Map Account [Posting]
 295  , transaction_sourcepos                 :: SourcePos
 296  , transaction_status                    :: Status
 297  , transaction_tags                      :: Tag.Tags
 298  } deriving (Data, Eq, Show, Typeable)
 299 instance NFData Transaction where
 300         rnf
 301          Transaction
 302          { transaction_code
 303          , transaction_comments_before
 304          , transaction_comments_after
 305          , transaction_dates
 306          , transaction_description
 307          , transaction_postings
 308          , transaction_virtual_postings
 309          , transaction_balanced_virtual_postings
 310          -- , transaction_sourcepos
 311          , transaction_status
 312          , transaction_tags
 313          } =
 314                 rnf transaction_code `seq`
 315                 rnf transaction_comments_before `seq`
 316                 rnf transaction_comments_after `seq`
 317                 rnf transaction_dates `seq`
 318                 rnf transaction_description `seq`
 319                 rnf transaction_postings `seq`
 320                 rnf transaction_virtual_postings `seq`
 321                 rnf transaction_balanced_virtual_postings `seq`
 322                 -- rnf transaction_sourcepos `seq`
 323                 rnf transaction_status `seq`
 324                 rnf transaction_tags
 325
 326
 327 transaction :: Transaction
 328 transaction =
 329         Transaction
 330          { transaction_code                      = ""
 331          , transaction_comments_before           = []
 332          , transaction_comments_after            = []
 333          , transaction_dates                     = (Date.nil, [])
 334          , transaction_description               = ""
 335          , transaction_postings                  = mempty
 336          , transaction_virtual_postings          = mempty
 337          , transaction_balanced_virtual_postings = mempty
 338          , transaction_sourcepos                 = initialPos ""
 339          , transaction_status                    = False
 340          , transaction_tags                      = mempty
 341          }
 342
 343 instance Filter.Transaction (Chart_With Transaction) where
 344         type Transaction_Posting  (Chart_With Transaction) = (Chart_With Posting)
 345         type Transaction_Postings (Chart_With Transaction) = Compose [] (Compose (Map Account) [])
 346         transaction_date        = fst . transaction_dates . with_chart
 347         transaction_description = transaction_description . with_chart
 348         transaction_postings (Chart_With c t)  =
 349                 fmap (Chart_With c) $
 350                 Compose
 351                  [ Compose $ transaction_postings t
 352                  ]
 353         transaction_postings_virtual (Chart_With c t) =
 354                 fmap (Chart_With c) $
 355                 Compose
 356                  [ Compose $ transaction_virtual_postings t
 357                  , Compose $ transaction_balanced_virtual_postings t
 358                  ]
 359         transaction_tags = transaction_tags . with_chart
 360
 361 --instance Journal.Transaction Transaction where
 362 --      transaction_date = fst . transaction_dates
 363 instance Journal.Transaction (Chart_With Transaction) where
 364         transaction_date = fst . transaction_dates . with_chart
 365
 366 instance Stats.Transaction  Transaction where
 367         type Transaction_Posting  Transaction = Posting
 368         type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
 369         transaction_date = fst . transaction_dates
 370         transaction_postings t =
 371                 Compose
 372                  [ Compose $ transaction_postings t
 373                  , Compose $ transaction_virtual_postings t
 374                  , Compose $ transaction_balanced_virtual_postings t
 375                  ]
 376         transaction_postings_size t =
 377                 Map.size (transaction_postings t) +
 378                 Map.size (transaction_virtual_postings t) +
 379                 Map.size (transaction_balanced_virtual_postings t)
 380         transaction_tags = transaction_tags
 381 instance Stats.Transaction  (Chart_With Transaction) where
 382         type Transaction_Posting  (Chart_With Transaction) = Stats.Transaction_Posting  Transaction
 383         type Transaction_Postings (Chart_With Transaction) = Stats.Transaction_Postings Transaction
 384         transaction_date = Stats.transaction_date . with_chart
 385         transaction_postings = Stats.transaction_postings . with_chart
 386         transaction_postings_size = Stats.transaction_postings_size . with_chart
 387         transaction_tags = Stats.transaction_tags . with_chart
 388
 389 instance GL.Transaction     Transaction where
 390         type Transaction_Posting  Transaction = Posting
 391         type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
 392         transaction_date = fst . transaction_dates
 393         transaction_postings t =
 394                 Compose
 395                  [ Compose $ transaction_postings t
 396                  , Compose $ transaction_virtual_postings t
 397                  , Compose $ transaction_balanced_virtual_postings t
 398                  ]
 399         transaction_postings_filter f t =
 400                 t{ transaction_postings =
 401                         Map.mapMaybe
 402                          (\p -> case List.filter f p of
 403                                  [] -> Nothing
 404                                  ps -> Just ps)
 405                          (transaction_postings t)
 406                  , transaction_virtual_postings =
 407                         Map.mapMaybe
 408                          (\p -> case List.filter f p of
 409                                  [] -> Nothing
 410                                  ps -> Just ps)
 411                          (transaction_virtual_postings t)
 412                  , transaction_balanced_virtual_postings =
 413                         Map.mapMaybe
 414                          (\p -> case List.filter f p of
 415                                  [] -> Nothing
 416                                  ps -> Just ps)
 417                          (transaction_balanced_virtual_postings t)
 418                  }
 419 instance GL.Transaction     (Chart_With Transaction) where
 420         type Transaction_Posting  (Chart_With Transaction) = (Chart_With (GL.Transaction_Posting Transaction))
 421         type Transaction_Postings (Chart_With Transaction) = GL.Transaction_Postings Transaction
 422         transaction_date = GL.transaction_date . with_chart
 423         transaction_postings (Chart_With c t) =
 424                 fmap (Chart_With c) $
 425                 GL.transaction_postings t
 426         transaction_postings_filter f (Chart_With c t) =
 427                 Chart_With c
 428                  t{ transaction_postings =
 429                         Map.mapMaybe
 430                          (\p -> case List.filter f $ fmap (Chart_With c) p of
 431                                  [] -> Nothing
 432                                  ps -> Just $ fmap with_chart ps)
 433                          (transaction_postings t)
 434                  , transaction_virtual_postings =
 435                         Map.mapMaybe
 436                          (\p -> case List.filter f $ fmap (Chart_With c) p of
 437                                  [] -> Nothing
 438                                  ps -> Just $ fmap with_chart ps)
 439                          (transaction_virtual_postings t)
 440                  , transaction_balanced_virtual_postings =
 441                         Map.mapMaybe
 442                          (\p -> case List.filter f $ fmap (Chart_With c) p of
 443                                  [] -> Nothing
 444                                  ps -> Just $ fmap with_chart ps)
 445                          (transaction_balanced_virtual_postings t)
 446                  }
 447
 448 -- | Return a 'Map.Map' associating
 449 --   the given 'Transaction's with their respective 'Date'.
 450 transaction_by_Date :: [Transaction] -> (Compose (Map Date) []) Transaction
 451 transaction_by_Date =
 452         Compose .
 453         Map.fromListWith (flip mappend) .
 454         List.map (\t -> (fst $ transaction_dates t, [t]))
 455
 456 -- * Type 'Journal'
 457
 458 data Monoid ts
 459  => Journal ts
 460  =  Journal
 461  { journal_file           :: FilePath
 462  , journal_includes       :: [Journal ts]
 463  , journal_last_read_time :: Date
 464  , journal_sections       :: !ts
 465  , journal_amount_styles  :: !Styles
 466  , journal_chart          :: Chart
 467  } deriving (Data, Eq, Show, Typeable)
 468
 469 journal :: Monoid ts => Journal ts
 470 journal =
 471         Journal
 472          { journal_file           = mempty
 473          , journal_includes       = mempty
 474          , journal_last_read_time = Date.nil
 475          , journal_sections       = mempty
 476          , journal_amount_styles  = mempty
 477          , journal_chart          = mempty
 478          }