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.Quantity
  22 import Hcompta.LCC.Account
  23 import Hcompta.LCC.Tag
  24
  25 -- * Type 'Chart'
  26 data Chart
  27  =   Chart
  28  {   chart_accounts :: !(TreeMap NameAccount Account_Tags)
  29  ,   chart_tags     :: !(Map Tag_Path (Map Account ()))
  30  } deriving (Data, Eq, Show, Typeable)
  31 instance NFData Chart where
  32         rnf Chart{..} =
  33                 rnf chart_accounts `seq`
  34                 rnf chart_tags
  35 instance Semigroup Chart where
  36         x <> y =
  37                 Chart
  38                  { chart_accounts = TreeMap.union (<>) (chart_accounts x) (chart_accounts y)
  39                  , chart_tags     = Map.unionWith (<>) (chart_tags x) (chart_tags y)
  40                  }
  41 instance Monoid Chart where
  42         mempty = Chart
  43          { chart_accounts = mempty
  44          , chart_tags     = mempty
  45          }
  46         mappend = (<>)
  47 instance Zeroable Chart where
  48         zero = mempty
  49 instance Nullable Chart where
  50         null = null . chart_accounts
  51
  52 -- * Zipper
  53
  54 type Zipper_Chart = TreeMap.Zipper NameAccount Account_Tags
  55 type Zipper_Account_Tags = TreeMap.Zipper Tag_Path_Section [Tag_Data]
  56 type Chart_Select = Zipper_Chart -> [Zipper_Chart]
  57 type Zipper_Select k a = TreeMap.Zipper k a -> [TreeMap.Zipper k a]
  58 type Zipper_SelectF f k a = TreeMap.Zipper k a -> f (TreeMap.Zipper k a)
  59
  60 zipper_chart :: Chart -> Zipper_Chart
  61 zipper_chart = TreeMap.zipper . chart_accounts
  62
  63 zipper_accounts_tags :: Zipper_Chart -> Zipper_Account_Tags
  64 zipper_accounts_tags z =
  65         case TreeMap.node_value $ TreeMap.zipper_self z of
  66          Strict.Just (Account_Tags (Tags tags)) -> TreeMap.zipper tags
  67          _ -> TreeMap.zipper TreeMap.empty
  68
  69 {-
  70 -- * Type 'Charted'
  71 data Charted a
  72  =   Charted
  73  {   chart   :: Chart
  74  ,   charted :: a
  75  } deriving (Data, Eq, Foldable, Functor, Show, Traversable, Typeable)
  76
  77 instance Ord a => Ord (Charted a) where
  78         compare = compare `on` charted
  79
  80
  81 instance H.Account (Charted Account)
  82 -- /child::A
  83 account_step account_child (\a -> "A" == a_name a)
  84 -- /child::A/child::B
  85 account_step account_child (\a -> "A" == a_name a) >=>
  86 account_step account_child (\a -> "B" == a_name a)
  87 -}