lib/Hcompta/Chart.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 {-# LANGUAGE StandaloneDeriving #-}
   4 {-# OPTIONS_GHC -fno-warn-deprecations #-} -- FIXME: to be removed when dropping GHC-7.6 support
   5 module Hcompta.Chart where
   6
   7 import           Control.DeepSeq (NFData(..))
   8 import           Data.Data (Data)
   9 import           Data.Eq (Eq(..))
  10 import           Data.Functor (Functor(..))
  11 -- import           Data.List (concat)
  12 -- import           Data.List.NonEmpty (NonEmpty(..))
  13 import qualified Data.Map.Strict as Data.Map
  14 import           Data.Monoid (Monoid(..))
  15 import           Data.Typeable
  16 import           Text.Show (Show(..))
  17 import           Prelude (($))
  18
  19 import           Hcompta.Account (Account(..))
  20 import           Hcompta.Lib.TreeMap (TreeMap)
  21 import qualified Hcompta.Lib.TreeMap as TreeMap
  22 -- import           Hcompta.Tag (Tag)
  23 import qualified Hcompta.Tag as Tag
  24
  25 data Account account
  26  => Chart account
  27  = Chart
  28  { chart_accounts :: TreeMap (Account_Section account) Tag.Tags
  29  -- , chart_tags     :: TreeMap Tag.Section [Account]
  30  }
  31 deriving instance ( Account        account
  32                   , Data           account
  33                   ) => Data (Chart account)
  34 deriving instance ( Account      account
  35                   , Eq           account
  36                   ) => Eq (Chart account)
  37 deriving instance ( Account        account
  38                   , Show           account
  39                   ) => Show (Chart account)
  40 deriving instance Typeable1 Chart
  41  -- FIXME: use 'Typeable' when dropping GHC-7.6 support
  42
  43 instance Account account => Monoid (Chart account) where
  44         mempty =
  45                 Chart
  46                  { chart_accounts = mempty
  47                  -- , chart_tags     = mempty
  48                  }
  49         mappend x y =
  50                 Chart
  51                  { chart_accounts = chart_accounts x `mappend` chart_accounts y
  52                  -- , chart_tags     = chart_tags     x `mappend` chart_tags     y
  53                  }
  54
  55 instance
  56  ( NFData  account
  57  , Account account
  58  ) => NFData (Chart account) where
  59         rnf (Chart a) = rnf a
  60
  61 -- | Return the 'Tag.Tags' associated with
  62 --   the given 'Account_Path'
  63 --   in the given 'Chart'.
  64 account_tags :: Account account => account -> Chart account -> Tag.Tags
  65 account_tags acct chart =
  66         Tag.Tags $ Data.Map.unionsWith mappend $
  67         fmap Tag.unTags $
  68         TreeMap.find_along (account_path acct) $
  69         chart_accounts chart
  70
  71 {-
  72 -- | Return the 'Account's associated with
  73 --   the given 'Tag'
  74 --   in the given 'Chart'.
  75 tag_accounts :: Tag -> Chart -> [Account]
  76 tag_accounts (p:|ps, value) chart =
  77         concat $
  78         TreeMap.find_along (p:|ps `mappend` [value]) $
  79         chart_tags chart
  80 -}