lcc/Hcompta/LCC/Chart.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE RecordWildCards #-}
   3 module Hcompta.LCC.Chart where
   4
   5 import Control.DeepSeq (NFData(..))
   6 import Data.Data
   7 import Data.Eq (Eq)
   8 import Data.Function (($), (.))
   9 import Data.Map.Strict (Map)
  10 import Data.Monoid (Monoid(..))
  11 import Data.Semigroup (Semigroup(..))
  12 import Data.Strict.Maybe as Strict
  13 import Data.TreeMap.Strict (TreeMap)
  14 import Data.Typeable ()
  15 import Prelude (seq)
  16 import Text.Show (Show)
  17 import qualified Data.Map.Strict as Map
  18 import qualified Data.TreeMap.Strict        as TreeMap
  19 import qualified Data.TreeMap.Strict.Zipper as TreeMap
  20
  21 import Hcompta.LCC.Account
  22 import Hcompta.LCC.Tag
  23
  24 -- * Type 'Chart'
  25 data Chart
  26  =   Chart
  27  {   chart_accounts :: !(TreeMap NameAccount Account_Tags)
  28  ,   chart_tags     :: !(Map Tag_Path (Map Account ()))
  29  } deriving (Data, Eq, Show, Typeable)
  30 instance NFData Chart where
  31         rnf Chart{..} =
  32                 rnf chart_accounts `seq`
  33                 rnf chart_tags
  34 instance Semigroup Chart where
  35         x <> y =
  36                 Chart
  37                  { chart_accounts = TreeMap.union (<>) (chart_accounts x) (chart_accounts y)
  38                  , chart_tags     = Map.unionWith (<>) (chart_tags x) (chart_tags y)
  39                  }
  40 instance Monoid Chart where
  41         mempty = Chart
  42          { chart_accounts = mempty
  43          , chart_tags     = mempty
  44          }
  45         mappend = (<>)
  46
  47 -- * Zipper
  48
  49 type Zipper_Chart = TreeMap.Zipper NameAccount Account_Tags
  50 type Zipper_Account_Tags = TreeMap.Zipper Tag_Path_Section [Tag_Data]
  51 type Chart_Select = Zipper_Chart -> [Zipper_Chart]
  52 type Zipper_Select k a = TreeMap.Zipper k a -> [TreeMap.Zipper k a]
  53 type Zipper_SelectF f k a = TreeMap.Zipper k a -> f (TreeMap.Zipper k a)
  54
  55 zipper_chart :: Chart -> Zipper_Chart
  56 zipper_chart = TreeMap.zipper . chart_accounts
  57
  58 zipper_accounts_tags :: Zipper_Chart -> Zipper_Account_Tags
  59 zipper_accounts_tags z =
  60         case TreeMap.node_value $ TreeMap.zipper_self z of
  61          Strict.Just (Account_Tags (Tags tags)) -> TreeMap.zipper tags
  62          _ -> TreeMap.zipper TreeMap.empty
  63
  64 {-
  65 -- * Type 'Charted'
  66 data Charted a
  67  =   Charted
  68  {   chart   :: Chart
  69  ,   charted :: a
  70  } deriving (Data, Eq, Foldable, Functor, Show, Traversable, Typeable)
  71
  72 instance Ord a => Ord (Charted a) where
  73         compare = compare `on` charted
  74
  75
  76 instance H.Account (Charted Account)
  77 -- /child::A
  78 account_step account_child (\a -> "A" == a_name a)
  79 -- /child::A/child::B
  80 account_step account_child (\a -> "A" == a_name a) >=>
  81 account_step account_child (\a -> "B" == a_name a)
  82 -}