jcc/Hcompta/JCC/Chart.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveFunctor #-}
   3 {-# LANGUAGE DeriveTraversable #-}
   4 {-# LANGUAGE FlexibleInstances #-}
   5 {-# LANGUAGE RecordWildCards #-}
   6 {-# LANGUAGE TypeFamilies #-}
   7 module Hcompta.JCC.Chart where
   8
   9 import           Control.DeepSeq (NFData(..))
  10 import           Data.Data
  11 import           Data.Eq (Eq)
  12 import           Data.Foldable (Foldable)
  13 import           Data.Function (on, (.))
  14 import           Data.Functor (Functor)
  15 import           Data.Map.Strict (Map)
  16 import           Data.Monoid (Monoid(..))
  17 import           Data.Ord (Ord(..))
  18 import           Data.Traversable (Traversable)
  19 import           Data.TreeMap.Strict (TreeMap)
  20 import           Data.Typeable ()
  21 import           Prelude (seq)
  22 import           Text.Show (Show)
  23
  24 import qualified Hcompta.Account as H
  25 import           Hcompta.JCC.Account
  26
  27 -- * Type 'Chart'
  28
  29 data Chart
  30  =   Chart
  31  {   chart_accounts :: TreeMap (H.Account_Section Account) H.Account_Tags
  32  ,   chart_anchors  :: Map H.Account_Anchor Account
  33  } deriving (Data, Eq, Show, Typeable)
  34 instance NFData Chart where
  35         rnf Chart{..} =
  36                 rnf chart_accounts `seq`
  37                 rnf chart_anchors
  38 instance Monoid Chart where
  39         mempty = Chart
  40          { chart_accounts = mempty
  41          , chart_anchors  = mempty
  42          }
  43         mappend x y =
  44                 Chart
  45                  { chart_accounts = chart_accounts x `mappend` chart_accounts y
  46                  , chart_anchors  = chart_anchors  x `mappend` chart_anchors  y
  47                  }
  48
  49 -- * Type 'Charted'
  50
  51 data Charted a
  52  =   Charted
  53  {   chart   :: Chart
  54  ,   charted :: a
  55  } deriving (Data, Eq, Foldable, Functor, Show, Traversable, Typeable)
  56
  57 instance Ord a => Ord (Charted a) where
  58         compare = compare `on` charted
  59 instance H.Account (Charted Account) where
  60         type Account_Section (Charted Account) = H.Account_Section Account
  61         account_path = H.account_path . charted