lib/Hcompta/Chart.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 -- {-# LANGUAGE DeriveDataTypeable #-}
   3 {-# LANGUAGE NamedFieldPuns #-}
   4 -- {-# LANGUAGE StandaloneDeriving #-}
   5 {-# LANGUAGE TypeFamilies #-}
   6 -- {-# OPTIONS_GHC -fno-warn-deprecations #-}
   7  -- FIXME: to be removed when dropping GHC-7.6 support
   8 module Hcompta.Chart where
   9
  10 import Data.Data
  11 import Data.Typeable
  12 import Text.Show (Show(..))
  13
  14 import Hcompta.Account
  15
  16 class Chart c where
  17         chart_account_tags   :: c -> account -> Account_Tags
  18         chart_anchor_account :: c -> Account_Anchor -> account
  19
  20 {-
  21 import           Control.DeepSeq (NFData(..))
  22 import           Data.Data (Data)
  23 import           Data.Eq (Eq(..))
  24 import           Data.Function (($), (.), on)
  25 import           Data.Functor (Functor(..))
  26 -- import           Data.List (concat)
  27 -- import           Data.List.NonEmpty (NonEmpty(..))
  28 import           Data.Map.Strict (Map)
  29 import qualified Data.Map.Strict as Map
  30 import           Data.Monoid (Monoid(..))
  31 import           Data.Ord (Ord(..))
  32 import           Data.TreeMap.Strict (TreeMap)
  33 import qualified Data.TreeMap.Strict as TreeMap
  34 import           Data.Typeable
  35 import           Prelude (seq)
  36 import           Text.Show (Show(..))
  37
  38 import qualified Hcompta.Account as Account
  39 import           Hcompta.Account (Account(..), Account_Anchor, Account_Tags(..))
  40 -- import qualified Hcompta.Anchor as Anchor
  41 import           Hcompta.Tag (Tags(..))
  42 -}
  43
  44 {-
  45 data Account account
  46  => Chart account account_data
  47  =  Chart
  48  { chart_accounts :: TreeMap (Account_Section account) account_data
  49  , chart_anchors  :: Map Account_Anchor account
  50  }
  51
  52 deriving instance ( Account             account
  53                   , Data                account
  54                   , Data                account_data
  55                   ) => Data (Chart account account_data)
  56 deriving instance ( Account             account
  57                   , Show                account
  58                   , Show                account_data
  59                   ) => Show (Chart account account_data)
  60 deriving instance Typeable2 Chart
  61
  62 instance
  63  ( Account account
  64  , Monoid account_data
  65  ) => Monoid (Chart account account_data) where
  66         mempty =
  67                 Chart
  68                  { chart_accounts = mempty
  69                  , chart_anchors  = mempty
  70                  }
  71         mappend x y =
  72                 Chart
  73                  { chart_accounts = chart_accounts x `mappend` chart_accounts y
  74                  , chart_anchors  = chart_anchors  x `mappend` chart_anchors  y
  75                  }
  76 data Charted account_section account account_data a
  77  =   Charted
  78  { chart   :: Chart account_section account account_data
  79  , charted :: a
  80  }
  81  deriving (Data, Show, Typeable)
  82 -}
  83
  84
  85 {-
  86 class Chart_Account_Data account_data where
  87         chart_account_data_tags :: account_data -> Account_Tags
  88
  89 data
  90  ( Account account
  91  , Chart_Account_Data account_data
  92  ) => Chart account account_data
  93  =  Chart
  94  { chart_accounts :: TreeMap (Account_Section account) account_data
  95  , chart_anchors  :: Map Account_Anchor account
  96  -- , chart_tags     :: Account_Tags
  97  }
  98 deriving instance ( Account             account
  99                   , Chart_Account_Data  account_data
 100                   , Data                account
 101                   , Data                account_data
 102                   ) => Data (Chart account account_data)
 103 deriving instance ( Account      account
 104                   , Eq           account
 105                   , Eq           account_data
 106                   ) => Eq (Chart account account_data)
 107 deriving instance ( Account        account
 108                   , Show           account
 109                   ) => Show (Chart account account_data)
 110 deriving instance Typeable2 Chart
 111  -- FIXME: use 'Typeable' when dropping GHC-7.6 support
 112
 113 instance Account account
 114  => Monoid (Chart account_data account) where
 115         mempty =
 116                 Chart
 117                  { chart_accounts   = mempty
 118                  -- , chart_tags = mempty
 119                  , chart_anchors    = mempty
 120                  }
 121         mappend x y =
 122                 Chart
 123                  { chart_accounts = chart_accounts    x `mappend` chart_accounts   y
 124                  -- , chart_tags = chart_tags  x `mappend` chart_tags y
 125                  , chart_anchors  = chart_anchors     x `mappend` chart_anchors    y
 126                  }
 127
 128 instance
 129  ( NFData  account
 130  , Account account
 131  ) => NFData (Chart account_data account) where
 132         rnf Chart{chart_accounts, chart_anchors} =
 133                 rnf chart_accounts `seq`
 134                 rnf chart_anchors
 135
 136 -- | Return the 'Account_Tags'
 137 --   associated with the given 'Account_Path'
 138 --   in the given 'Chart'.
 139 account_tags :: Account account => account -> Chart account account_data -> Account_Tags
 140 account_tags acct chart =
 141         Account_Tags $ Tags $
 142         Map.unionsWith mappend $
 143         fmap ((\(Account_Tags (Tags tags)) -> tags) . chart_account_data_tags) $
 144         TreeMap.find_along (account_path acct) $
 145         chart_accounts chart
 146
 147 data Charted account_data account x
 148  =   Charted
 149  { charted_chart :: Chart account account_data
 150  , charted       :: x
 151  }
 152  deriving (Data, Show, Typeable)
 153
 154 instance
 155  ( Account.Account account
 156  , Account.Account x
 157  ) =>  Account.Account (Charted account account_data x) where
 158         type Account_Section (Charted account account_data x) = Account.Account_Section x
 159         account_path = Account.account_path . charted
 160 instance
 161  ( Account account
 162  , Eq x
 163  ) => Eq (Charted account account_data x) where
 164         (==) = (==) `on` charted
 165 instance
 166  ( Account account
 167  , Ord x
 168  ) => Ord (Charted account account_data x) where
 169         compare = compare `on` charted
 170 instance Functor (Charted account account_data) where
 171         fmap f (Charted a x) = Charted a $ f x
 172 instance
 173  ( Account account
 174  , Monoid x
 175  ) => Monoid (Charted account account_data x) where
 176         mempty = Charted mempty mempty
 177         mappend (Charted xc xt) (Charted yc yt) =
 178                 Charted (mappend xc yc) (mappend xt yt)
 179 instance
 180  ( Account account
 181  , NFData account, NFData x
 182  ) => NFData (Charted account account_data x) where
 183         rnf (Charted c x) = rnf c `seq` rnf x
 184 -}
 185
 186 {-
 187 -- | Return the 'Account's associated with
 188 --   the given 'Tag'
 189 --   in the given 'Chart'.
 190 tag_accounts :: Tag -> Chart -> [Account]
 191 tag_accounts (p:|ps, value) chart =
 192         concat $
 193         TreeMap.find_along (p:|ps `mappend` [value]) $
 194         chart_tags chart
 195 -}