lcc/Hcompta/LCC/Transaction.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 {-# LANGUAGE NamedFieldPuns #-}
   7 {-# LANGUAGE RecordWildCards #-}
   8 {-# LANGUAGE TypeFamilies #-}
   9 module Hcompta.LCC.Transaction where
  10
  11 import Control.DeepSeq (NFData(..))
  12 import Data.Data (Data(..))
  13 import Data.Eq (Eq(..))
  14 import Data.Function (($), (.))
  15 import Data.Functor.Compose (Compose(..))
  16 import Data.Map.Strict (Map)
  17 import Data.Monoid (Monoid(..))
  18 import Data.NonNull (NonNull)
  19 import Data.Ord (Ord(..))
  20 import Data.String (IsString)
  21 import Data.Text (Text)
  22 import Data.Typeable (Typeable)
  23 import Prelude (flip, seq)
  24 import Text.Megaparsec.Pos (SourcePos, initialPos)
  25 import Text.Show (Show)
  26 import qualified Data.List as List
  27 import qualified Data.Map.Strict as Map
  28 import qualified Data.MonoTraversable as MT
  29 import qualified Data.NonNull as NonNull
  30
  31 import qualified Hcompta as H
  32
  33 import Hcompta.LCC.Account
  34 import Hcompta.LCC.Tag
  35 import Hcompta.LCC.Posting
  36 -- import Hcompta.LCC.Chart
  37
  38 -- * Type 'Transaction'
  39 data Transaction
  40  =   Transaction
  41  {   transaction_comments  :: [Comment]
  42  ,   transaction_dates     :: NonNull [Date]
  43  ,   transaction_postings  :: Postings
  44  ,   transaction_sourcepos :: SourcePos
  45  ,   transaction_tags      :: Transaction_Tags
  46  ,   transaction_wording   :: Wording
  47  } deriving (Data, Eq, Ord, Show, Typeable)
  48 transaction_date :: Transaction -> Date
  49 transaction_date = NonNull.head . transaction_dates
  50 instance H.Transaction Transaction
  51 instance NFData Transaction where
  52         rnf Transaction{..} =
  53                 rnf transaction_comments `seq`
  54                 rnf transaction_dates `seq`
  55                 rnf transaction_postings `seq`
  56                 -- rnf transaction_sourcepos `seq`
  57                 rnf transaction_tags `seq`
  58                 rnf transaction_wording
  59 type instance MT.Element Transaction = Posting
  60 instance MT.MonoFunctor Transaction where
  61         omap f t = t{transaction_postings = f `MT.omap` transaction_postings t}
  62 instance MT.MonoFoldable Transaction where
  63         ofoldMap f   = MT.ofoldMap f   . transaction_postings
  64         ofoldr f a   = MT.ofoldr f a   . transaction_postings
  65         ofoldl' f a  = MT.ofoldl' f a  . transaction_postings
  66         ofoldr1Ex f  = MT.ofoldr1Ex f  . transaction_postings
  67         ofoldl1Ex' f = MT.ofoldl1Ex' f . transaction_postings
  68
  69 type instance H.Date H.:@ Transaction = Date
  70 instance H.GetI H.Date Transaction where
  71         getI_ _ = NonNull.head . transaction_dates
  72 instance H.SetI H.Date Transaction where
  73         setI_ _ d t = t{transaction_dates =
  74                 NonNull.ncons d $ NonNull.tail $ transaction_dates t}
  75
  76 type instance H.Postings H.:@ Transaction = Postings
  77 instance H.GetI H.Postings Transaction where
  78         getI_ _ = transaction_postings
  79 instance H.SetI H.Postings Transaction where
  80         setI_ _ transaction_postings t = t{transaction_postings}
  81
  82 transaction :: Transaction
  83 transaction =
  84         Transaction
  85          { transaction_comments  = []
  86          , transaction_dates     = NonNull.ncons H.date_epoch []
  87          , transaction_postings  = mempty
  88          , transaction_sourcepos = initialPos ""
  89          , transaction_tags      = mempty
  90          , transaction_wording   = ""
  91          }
  92
  93 {-
  94 -- ** Type 'Transaction_Anchor'
  95 newtype Transaction_Anchor = Transaction_Anchor Anchor
  96  deriving (Data, Eq, NFData, Ord, Show, Typeable)
  97 -- ** Type 'Transaction_Anchors'
  98 newtype Transaction_Anchors = Transaction_Anchors Anchors
  99  deriving (Data, Eq, Monoid, NFData, Ord, Show, Typeable)
 100 type instance MT.Element Transaction_Anchors = Transaction_Anchor
 101 -}
 102
 103 -- ** Type 'Transaction_Tag'
 104 newtype Transaction_Tag = Transaction_Tag Tag
 105  deriving (Data, Eq, NFData, Ord, Show, Typeable)
 106 -- ** Type 'Transaction_Tags'
 107 newtype Transaction_Tags = Transaction_Tags Tags
 108  deriving (Data, Eq, Monoid, NFData, Ord, Show, Typeable)
 109 type instance MT.Element Transaction_Tags = Transaction_Tag
 110
 111 -- ** Type 'Transactions'
 112 newtype Transactions = Transactions (Map Account [Transaction])
 113  deriving (Data, Eq, NFData, Ord, Show, Typeable)
 114
 115 type instance MT.Element Transactions = Transaction
 116 instance H.Transactions Transactions
 117
 118 -- ** Type 'Wording'
 119 newtype Wording = Wording Text
 120  deriving (Data, Eq, IsString, NFData, Ord, Show, Typeable)
 121
 122
 123
 124
 125
 126
 127
 128 {-
 129
 130 -- Transaction
 131 instance H.Transaction      Transaction where
 132         type Transaction_Posting  Transaction = Posting
 133         type Transaction_Postings Transaction = Compose (Map Account) [] Posting
 134         transaction_date        = fst . transaction_dates
 135         transaction_description = transaction_wording
 136         transaction_postings    = Compose . transaction_postings
 137         transaction_tags        = transaction_tags
 138 instance H.Transaction      (Charted Transaction) where
 139         type Transaction_Posting  (Charted Transaction) = H.Transaction_Posting  Transaction
 140         type Transaction_Postings (Charted Transaction) = H.Transaction_Postings Transaction
 141         transaction_date        = H.transaction_date . charted
 142         transaction_description = H.transaction_description . charted
 143         transaction_postings    = H.transaction_postings . charted
 144         transaction_tags        = H.transaction_tags . charted
 145
 146 -- Journal
 147 instance H.Journal_Transaction Transaction
 148 instance H.Journal_Transaction (Charted Transaction)
 149
 150 -- Stats
 151 instance H.Stats_Transaction Transaction where
 152         stats_transaction_postings_count = Map.size . transaction_postings
 153 instance H.Stats_Transaction (Charted Transaction) where
 154         stats_transaction_postings_count = H.stats_transaction_postings_count . charted
 155
 156 -- GL
 157 instance H.GL_Transaction  Transaction where
 158         type GL_Transaction_Line Transaction = Transaction
 159         gl_transaction_line = id
 160         {-
 161         gl_transaction_postings_filter f t =
 162                 t{ transaction_postings =
 163                         Map.mapMaybe
 164                          (\post -> case List.filter f post of
 165                                  [] -> Nothing
 166                                  posts -> Just posts)
 167                          (transaction_postings t)
 168                  }
 169         -}
 170 instance H.GL_Transaction  (Charted Transaction) where
 171         type GL_Transaction_Line (Charted Transaction) = H.GL_Transaction_Line Transaction
 172         gl_transaction_line = H.gl_transaction_line . charted
 173         {-
 174         gl_transaction_postings_filter f (Charted c t) =
 175                 Charted c
 176                  t{ transaction_postings =
 177                         Map.mapMaybe
 178                          (\post -> case List.filter f $ ({-Charted c <$>-} post) of
 179                                  [] -> Nothing
 180                                  posts -> Just $ {-charted <$>-} posts)
 181                          (transaction_postings t)
 182                  }
 183         -}
 184
 185 {-
 186 instance Filter.Transaction (Charted Transaction) where
 187         type Transaction_Posting  (Charted Transaction) = Charted Posting
 188         type Transaction_Postings (Charted Transaction) = Compose (Map Account) []
 189         transaction_date = fst . transaction_dates . Chart.charted
 190         transaction_wording = transaction_wording . Chart.charted
 191         transaction_postings (Chart.Charted c t)  =
 192                 fmap (Chart.Charted c) $
 193                 Compose $ transaction_postings t
 194         {-
 195         transaction_postings_virtual (Chart.Charted c t) =
 196                 fmap (Chart.Charted c) $
 197                 Compose
 198                  [ Compose $ transaction_virtual_postings t
 199                  , Compose $ transaction_balanced_virtual_postings t
 200                  ]
 201         -}
 202         transaction_tags = transaction_tags . Chart.charted
 203 -}
 204 -}
 205 -- | Return a 'Map' associating
 206 --   the given 'Transaction's with their respective 'Date'.
 207 transaction_by_date :: [Transaction] -> (Compose (Map Date) []) Transaction
 208 transaction_by_date =
 209         Compose .
 210         Map.fromListWith (flip mappend) .
 211         List.map (\t -> (NonNull.head $ transaction_dates t, [t]))