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.NonNull (NonNull)
  15 import qualified Data.MonoTraversable as MT
  16 import Data.Monoid (Monoid(..))
  17 import qualified Data.NonNull as NonNull
  18 import Data.Ord (Ord(..))
  19 import Data.Semigroup (Semigroup(..))
  20 import qualified Data.Time.Clock as Time
  21 import qualified Data.TreeMap.Strict as TreeMap
  22 import Data.Typeable (Typeable)
  23 import Text.Show (Show)
  24
  25 import Hcompta.LCC.Anchor
  26 import Hcompta.LCC.Tag
  27 import Hcompta.LCC.Name
  28 import qualified Hcompta as H
  29
  30 -- * Type 'Account'
  31 newtype Account = Account (NonNull [Account_Section])
  32  deriving (Data, Eq, MT.MonoFunctor, MT.MonoFoldable
  33  , NFData, Ord, Semigroup, Show, Typeable)
  34 type instance MT.Element Account = Account_Section
  35 instance H.Get (TreeMap.Path Account_Section) Account where
  36         get (Account n) = x :| xs where (x, xs) = NonNull.splitFirst n
  37 instance H.Get Account (TreeMap.Path Account_Section) where
  38         get (x :| xs) = Account (NonNull.ncons x xs)
  39 instance H.Account Account
  40
  41 -- ** Type 'Account_Section'
  42 type Account_Section = Name
  43
  44 -- * Type 'Account_Anchor'
  45 newtype Account_Anchor = Account_Anchor Anchor
  46  deriving (Data, Eq, Ord, NFData, Show, Typeable)
  47
  48 -- * Type 'Account_Tag'
  49 newtype Account_Tag = Account_Tag Tag
  50  deriving (Data, Eq, NFData, Show, Typeable)
  51 instance MT.MonoFunctor Account_Tag where
  52         omap f (Account_Tag tag) = Account_Tag (f tag)
  53 type instance MT.Element Account_Tag = Tag
  54 type instance H.Tag_Path  H.:@ Account_Tag = Tag_Path
  55 type instance H.Tag_Value H.:@ Account_Tag = Tag_Value
  56
  57 -- ** Type 'Account_Tags'
  58 newtype Account_Tags
  59  =      Account_Tags Tags
  60  deriving (Data, Eq, Monoid, NFData, Show, Typeable)
  61 type instance MT.Element Account_Tags = Account_Tag
  62
  63 instance H.GetI H.Tag_Path Account_Tag where
  64         getI _ (Account_Tag tag) = tag_path tag
  65 instance H.SetI H.Tag_Path Account_Tag where
  66         setI _ tag_path = MT.omap (\tag -> tag{tag_path})
  67 instance H.GetI H.Tag_Value Account_Tag where
  68         getI _ (Account_Tag tag) = tag_value tag
  69 instance H.SetI H.Tag_Value Account_Tag where
  70         setI _ tag_value = MT.omap (\tag -> tag{tag_value})
  71
  72 -- * Type 'Date'
  73 type Date = Time.UTCTime
  74