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