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)
  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 [NameAccount])
  31  deriving (Data, Eq, MT.MonoFunctor, MT.MonoFoldable
  32  , NFData, Ord, Semigroup, Show, Typeable)
  33
  34 type instance MT.Element Account = NameAccount
  35
  36 {-
  37 instance H.Get (TreeMap.Path NameAccount) Account where
  38         get (Account n) = n
  39 instance H.Get Account (TreeMap.Path NameAccount) where
  40         get = Account
  41 instance H.Account Account
  42 -}
  43 instance H.To Account (TreeMap.Path NameAccount) where
  44         to = Account
  45 instance H.To (TreeMap.Path NameAccount) Account where
  46         to (Account a) = a
  47
  48 -- ** Type 'NameAccount'
  49 type NameAccount = Name
  50
  51 {-
  52 -- * Type 'Account_Anchor'
  53 newtype Account_Anchor = Account_Anchor Anchor
  54  deriving (Data, Eq, Ord, NFData, Show, Typeable)
  55 -- ** Type 'Account_Anchors'
  56 newtype Account_Anchors = Account_Anchors Anchors
  57  deriving (Data, Eq, Monoid, NFData, Ord, Semigroup, Show, Typeable)
  58 type instance MT.Element Account_Anchors = Account_Anchor
  59 -}
  60
  61 -- * Type 'Account_Tag'
  62 newtype Account_Tag = Account_Tag Tag
  63  deriving (Data, Eq, NFData, Show, Typeable)
  64
  65 type instance MT.Element Account_Tag = Tag
  66 -- type instance H.Tag_Path H.:@ Account_Tag = Tag_Path
  67 -- type instance H.Tag_Data H.:@ Account_Tag = Tag_Data
  68
  69 instance MT.MonoFunctor Account_Tag where
  70         omap f (Account_Tag tag) = Account_Tag (f tag)
  71
  72 -- ** Type 'Account_Tags'
  73 newtype Account_Tags
  74  =      Account_Tags Tags
  75  deriving (Data, Eq, Monoid, NFData, Semigroup, Show, Typeable)
  76
  77 type instance MT.Element Account_Tags = Account_Tag
  78
  79 {-
  80 instance H.GetI H.Tag_Path Account_Tag where
  81         getI (Account_Tag tag) = tag_path tag
  82 instance H.SetI H.Tag_Path Account_Tag where
  83         setI tag_path = MT.omap (\tag -> tag{tag_path})
  84 instance H.GetI H.Tag_Data Account_Tag where
  85         getI (Account_Tag tag) = tag_data tag
  86 instance H.SetI H.Tag_Data Account_Tag where
  87         setI tag_data = MT.omap (\tag -> tag{tag_data})
  88 -}