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 -- | Return the 'Account's associated with
  53 --   the given 'Tag'
  54 --   in the given 'Chart'.
  55 tag_accounts :: Tag -> Chart -> [Account]
  56 tag_accounts (p:|ps, value) chart =
  57         concat $
  58         TreeMap.find_along (p:|ps `mappend` [value]) $
  59         chart_tags chart