lcc/Hcompta/LCC/Account.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE NamedFieldPuns #-}
   6 {-# LANGUAGE TypeFamilies #-}
   7 {-# OPTIONS_GHC -fno-warn-orphans #-}
   8 module Hcompta.LCC.Account where
   9
  10 import Control.DeepSeq (NFData(..))
  11 import Data.Data (Data(..))
  12 import Data.Eq (Eq(..))
  13 import Data.List.NonEmpty (NonEmpty(..))
  14 import Data.Monoid (Monoid(..))
  15 import Data.NonNull (NonNull, ncons)
  16 import Data.Ord (Ord(..))
  17 import Data.Semigroup (Semigroup(..))
  18 import Data.Typeable (Typeable)
  19 import Text.Show (Show)
  20 import qualified Data.MonoTraversable as MT
  21 import qualified Data.NonNull as NonNull
  22 import qualified Data.TreeMap.Strict as TreeMap
  23
  24 -- import Hcompta.LCC.Anchor
  25 import Hcompta.LCC.Tag
  26 import Hcompta.LCC.Name
  27 import qualified Hcompta as H
  28
  29 -- * Type 'Account'
  30 newtype Account = Account (NonNull [Account_Section])
  31  deriving (Data, Eq, MT.MonoFunctor, MT.MonoFoldable
  32  , NFData, Ord, Semigroup, Show, Typeable)
  33 type instance MT.Element Account = Account_Section
  34 instance H.Get (TreeMap.Path Account_Section) Account where
  35         get (Account n) = n
  36 instance H.Get Account (TreeMap.Path Account_Section) where
  37         get = Account
  38 instance H.Account Account
  39
  40 -- ** Type 'Account_Section'
  41 type Account_Section = Name
  42
  43 {-
  44 -- * Type 'Account_Anchor'
  45 newtype Account_Anchor = Account_Anchor Anchor
  46  deriving (Data, Eq, Ord, NFData, Show, Typeable)
  47 -- ** Type 'Account_Anchors'
  48 newtype Account_Anchors = Account_Anchors Anchors
  49  deriving (Data, Eq, Monoid, NFData, Ord, Semigroup, Show, Typeable)
  50 type instance MT.Element Account_Anchors = Account_Anchor
  51 -}
  52
  53 -- * Type 'Account_Tag'
  54 newtype Account_Tag = Account_Tag Tag
  55  deriving (Data, Eq, NFData, Show, Typeable)
  56 instance MT.MonoFunctor Account_Tag where
  57         omap f (Account_Tag tag) = Account_Tag (f tag)
  58 type instance MT.Element Account_Tag = Tag
  59 type instance H.Tag_Path H.:@ Account_Tag = Tag_Path
  60 type instance H.Tag_Data H.:@ Account_Tag = Tag_Data
  61
  62 -- ** Type 'Account_Tags'
  63 newtype Account_Tags
  64  =      Account_Tags Tags
  65  deriving (Data, Eq, Monoid, NFData, Semigroup, Show, Typeable)
  66 type instance MT.Element Account_Tags = Account_Tag
  67
  68 instance H.GetI H.Tag_Path Account_Tag where
  69         getI_ _ (Account_Tag tag) = tag_path tag
  70 instance H.SetI H.Tag_Path Account_Tag where
  71         setI_ _ tag_path = MT.omap (\tag -> tag{tag_path})
  72 instance H.GetI H.Tag_Data Account_Tag where
  73         getI_ _ (Account_Tag tag) = tag_data tag
  74 instance H.SetI H.Tag_Data Account_Tag where
  75         setI_ _ tag_data = MT.omap (\tag -> tag{tag_data})
  76