lib/Hcompta/Chart.hs

   1 {-# LANGUAGE BangPatterns #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 module Hcompta.Chart where
   4
   5 import           Data.Data (Data)
   6 import           Data.Eq (Eq(..))
   7 import           Data.Functor (Functor(..))
   8 -- import           Data.List (concat)
   9 -- import           Data.List.NonEmpty (NonEmpty(..))
  10 import qualified Data.Map.Strict as Data.Map
  11 import           Data.Monoid (Monoid(..))
  12 import           Data.Typeable (Typeable)
  13 import           Text.Show (Show(..))
  14 import           Prelude (($))
  15
  16 -- import           Hcompta.Account (Account)
  17 import qualified Hcompta.Account as Account
  18 import           Hcompta.Lib.TreeMap (TreeMap)
  19 import qualified Hcompta.Lib.TreeMap as TreeMap
  20 -- import           Hcompta.Tag (Tag)
  21 import qualified Hcompta.Tag as Tag
  22
  23 data Chart =
  24  Chart
  25  { chart_accounts :: !(TreeMap Account.Account_Section Tag.Tags)
  26  -- , chart_tags     :: !(TreeMap Tag.Section [Account])
  27  }
  28  deriving (Data, Eq, Show, Typeable)
  29
  30 instance Monoid Chart where
  31         mempty =
  32                 Chart
  33                  { chart_accounts = mempty
  34                  -- , chart_tags     = mempty
  35                  }
  36         mappend x y =
  37                 Chart
  38                  { chart_accounts = chart_accounts x `mappend` chart_accounts y
  39                  -- , chart_tags     = chart_tags     x `mappend` chart_tags     y
  40                  }
  41
  42 -- | Return the 'Tag.Tags' associated with
  43 --   the given 'Account.Account_Path'
  44 --   in the given 'Chart'.
  45 account_tags :: Account.Account_Path -> Chart -> Tag.Tags
  46 account_tags acct chart =
  47         Tag.Tags $ Data.Map.unionsWith mappend $
  48         fmap Tag.unTags $
  49         TreeMap.find_along acct $
  50         chart_accounts chart
  51
  52 {-
  53 -- | Return the 'Account's associated with
  54 --   the given 'Tag'
  55 --   in the given 'Chart'.
  56 tag_accounts :: Tag -> Chart -> [Account]
  57 tag_accounts (p:|ps, value) chart =
  58         concat $
  59         TreeMap.find_along (p:|ps `mappend` [value]) $
  60         chart_tags chart
  61 -}