jcc/Hcompta/Format/JCC.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE MultiParamTypeClasses #-}
   4 {-# LANGUAGE NamedFieldPuns #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 {-# LANGUAGE TupleSections #-}
   7 {-# LANGUAGE TypeFamilies #-}
   8 {-# OPTIONS_GHC -fno-warn-orphans #-}
   9 module Hcompta.Format.JCC
  10  ( module Hcompta.Format.JCC
  11  , module Hcompta.Format.JCC.Amount
  12  , module Hcompta.Format.JCC.Unit
  13  , module Hcompta.Format.JCC.Quantity
  14  ) where
  15
  16 -- import           Control.Applicative (Const(..))
  17 import           Control.DeepSeq (NFData(..))
  18 import           Data.Data (Data(..))
  19 import           Data.Eq (Eq(..))
  20 import           Data.Function (id)
  21 import           Data.Functor (Functor(..))
  22 import           Data.Functor.Compose (Compose(..))
  23 import qualified Data.List as List
  24 import           Data.List.NonEmpty (NonEmpty(..))
  25 import           Data.Map.Strict (Map)
  26 import qualified Data.Map.Strict as Map
  27 import           Data.Maybe (Maybe(..))
  28 import           Data.Monoid (Monoid(..))
  29 import           Data.Ord (Ord(..))
  30 import           Data.Text (Text)
  31 import           Data.Tuple (fst, uncurry)
  32 import           Data.Typeable (Typeable)
  33 import           Prelude (($), (.), FilePath, flip, seq, undefined)
  34 import           Text.Parsec.Pos (SourcePos, initialPos)
  35 import           Text.Show (Show(..))
  36
  37 import           Hcompta.Account (Account_Anchor, Account_Tags)
  38 -- import qualified Hcompta.Amount as Amount
  39 -- import           Hcompta.Balance (Balance(..))
  40 import qualified Hcompta.Balance as Balance
  41 import qualified Hcompta.Chart as Chart
  42 import           Hcompta.Date (Date)
  43 import qualified Hcompta.Date as Date
  44 import qualified Hcompta.Filter as Filter
  45 import qualified Hcompta.Filter.Read as Filter.Read
  46 -- import           Hcompta.GL (GL(..))
  47 import qualified Hcompta.GL as GL
  48 import qualified Hcompta.Journal as Journal
  49 -- import           Hcompta.Lib.Consable
  50 import           Hcompta.Lib.Parsec ()
  51 import           Hcompta.Lib.Regex (Regex)
  52 import qualified Hcompta.Polarize as Polarize
  53 import           Hcompta.Posting (Posting_Anchors, Posting_Tags)
  54 import qualified Hcompta.Posting as Posting
  55 -- import qualified Hcompta.Quantity as Quantity
  56 import qualified Hcompta.Stats as Stats
  57 import           Hcompta.Transaction (Transaction_Anchors, Transaction_Tags)
  58
  59 import           Hcompta.Format.JCC.Amount
  60 import           Hcompta.Format.JCC.Quantity
  61 import           Hcompta.Format.JCC.Unit
  62
  63 -- * Type 'Account'
  64
  65 type Account_Section = Text
  66 type Account = NonEmpty Account_Section
  67 account :: Account_Section -> [Account_Section] -> Account
  68 account = (:|)
  69
  70 -- ** Type 'Joker'
  71
  72 type Account_Joker
  73  = [Account_Joker_Section]
  74 data Account_Joker_Section
  75  =   Account_Joker_Any
  76  |   Account_Joker_Section Text
  77  deriving (Data, Eq, Show, Typeable)
  78
  79 -- ** Type 'Pattern'
  80
  81 data Account_Pattern
  82  =   Account_Pattern_Exact Account
  83  |   Account_Pattern_Joker Account_Joker
  84  |   Account_Pattern_Regex Regex
  85  deriving (Show, Typeable)
  86
  87 -- * Type 'Chart'
  88
  89 type Chart   = Chart.Chart   Account
  90 type Charted = Chart.Charted Account
  91
  92 -- * Type 'Posting'
  93
  94 data Posting
  95  =   Posting
  96  { posting_account        :: Account
  97  , posting_account_anchor :: Maybe (Account_Anchor, Maybe Account)
  98  , posting_amounts        :: Map Unit Quantity
  99  , posting_anchors        :: Posting_Anchors
 100  , posting_comments       :: [Comment]
 101  , posting_dates          :: [Date]
 102  , posting_sourcepos      :: SourcePos
 103  , posting_tags           :: Posting_Tags
 104  } deriving (Data, Eq, Show, Typeable)
 105 instance NFData Posting where
 106         rnf
 107          Posting
 108          { posting_account
 109          , posting_account_anchor
 110          , posting_amounts
 111          , posting_anchors
 112          , posting_comments
 113          , posting_dates
 114          -- , posting_sourcepos
 115          , posting_tags
 116          } =
 117                 rnf posting_account `seq`
 118                 rnf posting_account_anchor `seq`
 119                 rnf posting_amounts `seq`
 120                 rnf posting_anchors `seq`
 121                 rnf posting_comments `seq`
 122                 rnf posting_dates `seq`
 123                 -- rnf posting_sourcepos
 124                 rnf posting_tags
 125
 126 posting :: Account -> Posting
 127 posting acct =
 128         Posting
 129          { posting_account        = acct
 130          , posting_account_anchor = Nothing
 131          , posting_amounts        = mempty
 132          , posting_anchors        = mempty
 133          , posting_comments       = mempty
 134          , posting_dates          = mempty
 135          , posting_sourcepos      = initialPos ""
 136          , posting_tags           = mempty
 137          }
 138
 139 map_Postings_by_Account :: [Posting] -> Map Account [Posting]
 140 map_Postings_by_Account =
 141         Map.fromListWith (flip mappend) .
 142         List.map (\p -> (posting_account p, [p]))
 143
 144 instance Posting.Posting Posting where
 145         type Posting_Account   Posting = Account
 146         type Posting_Amount    Posting = Amount
 147         type Posting_Amounts   Posting = []
 148         posting_account = posting_account
 149         posting_amounts = List.map (uncurry Amount) . Map.toList . posting_amounts
 150
 151 instance Posting.Posting (Charted Posting) where
 152         type Posting_Account   (Charted Posting) = Charted Account
 153         type Posting_Amount    (Charted Posting) = Posting.Posting_Amount  Posting
 154         type Posting_Amounts   (Charted Posting) = Posting.Posting_Amounts Posting
 155         posting_account (Chart.Charted c p) = Chart.Charted c $ Posting.posting_account p
 156         posting_amounts = Posting.posting_amounts . Chart.charted
 157
 158 instance Balance.Posting Posting where
 159         type Posting_Account   Posting = Account
 160         type Posting_Quantity  Posting = Polarize.Polarized Quantity
 161         type Posting_Unit      Posting = Unit
 162         posting_account = posting_account
 163         posting_amounts = Map.map Polarize.polarize . posting_amounts
 164         posting_set_amounts amounts p =
 165                 p { posting_amounts=Map.map Polarize.depolarize amounts }
 166
 167 instance Balance.Posting (Charted Posting) where
 168         type Posting_Account   (Charted Posting) = Account
 169         type Posting_Quantity  (Charted Posting) = Balance.Posting_Quantity Posting
 170         type Posting_Unit      (Charted Posting) = Balance.Posting_Unit     Posting
 171         posting_account = posting_account . Chart.charted
 172         posting_amounts = Map.map Polarize.polarize . posting_amounts . Chart.charted
 173         posting_set_amounts amounts (Chart.Charted c p) =
 174                 Chart.Charted c p{ posting_amounts=Map.map Polarize.depolarize amounts }
 175
 176 instance Show Filter.Read.Forall_Filter_Balance_Decimal where
 177         show t = show $
 178                 (Filter.Read.get_Forall_Filter_Balance_Decimal t
 179                 :: Filter.Filter_Balance
 180                          ( (Account_Tags, Account)
 181                          , (Unit, Polarize.Polarized Quantity)
 182                          ))
 183
 184 instance Filter.Posting (Charted Posting) where
 185         posting_type = undefined
 186          -- NOTE: the posting_type will be given to Filter.test
 187          --       through instance Posting p => Posting (Posting_Typed p)
 188          --       by Filter.transaction_postings
 189          --       and Filter.transaction_postings_virtual
 190
 191 instance GL.Posting     Posting where
 192         type Posting_Account  Posting = Account
 193         type Posting_Quantity Posting = Map Unit (Polarize.Polarized Quantity)
 194         posting_account  = posting_account
 195         posting_quantity = Map.map Polarize.polarize . posting_amounts
 196
 197 instance GL.Posting     (Charted Posting) where
 198         type Posting_Account  (Charted Posting) = Account
 199         type Posting_Quantity (Charted Posting) = GL.Posting_Quantity Posting
 200         posting_account  = GL.posting_account  . Chart.charted
 201         posting_quantity = GL.posting_quantity . Chart.charted
 202
 203 instance Stats.Posting  Posting where
 204         type Posting_Account  Posting = Account
 205         type Posting_Quantity Posting = Quantity
 206         type Posting_Unit     Posting = Unit
 207         posting_account = posting_account
 208         posting_amounts = posting_amounts
 209
 210 instance Show Filter.Read.Forall_Filter_Posting_Decimal where
 211         show t = show $
 212                 (Filter.Read.get_Forall_Filter_Posting_Decimal t
 213                 :: Filter.Filter_Posting (Charted Posting))
 214
 215 -- * Type 'Transaction'
 216
 217 type Code     = Text
 218 type Comment  = Text
 219 type Comments = [Comment]
 220 type Wording  = Text
 221
 222 data Transaction
 223  =   Transaction
 224  { transaction_anchors   :: Transaction_Anchors
 225  , transaction_comments  :: Comments
 226  , transaction_dates     :: (Date, [Date])
 227  , transaction_postings  :: Map Account [Posting]
 228  , transaction_sourcepos :: SourcePos
 229  , transaction_tags      :: Transaction_Tags
 230  , transaction_wording   :: Wording
 231  } deriving (Data, Eq, Show, Typeable)
 232 instance NFData Transaction where
 233         rnf
 234          Transaction
 235          { transaction_tags
 236          , transaction_comments
 237          , transaction_dates
 238          , transaction_wording
 239          , transaction_postings
 240          -- , transaction_sourcepos
 241          } =
 242                 rnf transaction_comments `seq`
 243                 rnf transaction_dates `seq`
 244                 rnf transaction_postings `seq`
 245                 rnf transaction_tags `seq`
 246                 -- rnf transaction_sourcepos `seq`
 247                 rnf transaction_wording
 248
 249 transaction :: Transaction
 250 transaction =
 251         Transaction
 252          { transaction_anchors   = mempty
 253          , transaction_comments  = []
 254          , transaction_dates     = (Date.nil, [])
 255          , transaction_postings  = mempty
 256          , transaction_sourcepos = initialPos ""
 257          , transaction_tags      = mempty
 258          , transaction_wording   = ""
 259          }
 260
 261 instance Filter.Transaction (Charted Transaction) where
 262         type Transaction_Posting  (Charted Transaction) = Charted Posting
 263         type Transaction_Postings (Charted Transaction) = Compose (Map Account) []
 264         transaction_date = fst . transaction_dates . Chart.charted
 265         transaction_wording = transaction_wording . Chart.charted
 266         transaction_postings (Chart.Charted c t)  =
 267                 fmap (Chart.Charted c) $
 268                 Compose $ transaction_postings t
 269         transaction_tags = transaction_tags . Chart.charted
 270
 271 instance Show Filter.Read.Forall_Filter_Transaction_Decimal where
 272         show t = show $
 273                 (Filter.Read.get_Forall_Filter_Transaction_Decimal t
 274                 :: Filter.Filter_Transaction (Charted Transaction))
 275
 276 instance Journal.Transaction Transaction where
 277         transaction_date = fst . transaction_dates
 278 instance Journal.Transaction (Charted Transaction) where
 279         transaction_date = Journal.transaction_date . Chart.charted
 280
 281 instance Stats.Transaction  Transaction where
 282         type Transaction_Posting  Transaction = Posting
 283         type Transaction_Postings Transaction = Compose (Map Account) []
 284         transaction_date = fst . transaction_dates
 285         transaction_postings = Compose . transaction_postings
 286         transaction_postings_size t =
 287                 Map.size (transaction_postings t)
 288         transaction_tags = transaction_tags
 289 instance Stats.Transaction  (Charted Transaction) where
 290         type Transaction_Posting  (Charted Transaction) = Stats.Transaction_Posting  Transaction
 291         type Transaction_Postings (Charted Transaction) = Stats.Transaction_Postings Transaction
 292         transaction_date = Stats.transaction_date . Chart.charted
 293         transaction_postings = Stats.transaction_postings . Chart.charted
 294         transaction_postings_size = Stats.transaction_postings_size . Chart.charted
 295         transaction_tags = Stats.transaction_tags . Chart.charted
 296
 297 instance GL.Transaction     Transaction where
 298         type Transaction_Line     Transaction = Transaction
 299         type Transaction_Posting  Transaction = Posting
 300         type Transaction_Postings Transaction = Compose (Map Account) []
 301         transaction_line = id
 302         transaction_date = fst . transaction_dates
 303         transaction_postings = Compose . transaction_postings
 304         transaction_postings_filter f t =
 305                 t{ transaction_postings =
 306                         Map.mapMaybe
 307                          (\p -> case List.filter f p of
 308                                  [] -> Nothing
 309                                  ps -> Just ps)
 310                          (transaction_postings t)
 311                  }
 312 instance GL.Transaction     (Charted Transaction) where
 313         type Transaction_Line     (Charted Transaction) = Transaction
 314         type Transaction_Posting  (Charted Transaction) = Charted (GL.Transaction_Posting Transaction)
 315         type Transaction_Postings (Charted Transaction) = GL.Transaction_Postings Transaction
 316         transaction_line = Chart.charted
 317         transaction_date = GL.transaction_date . Chart.charted
 318         transaction_postings (Chart.Charted c t) =
 319                 fmap (Chart.Charted c) $
 320                 GL.transaction_postings t
 321         transaction_postings_filter f (Chart.Charted c t) =
 322                 Chart.Charted c
 323                  t{ transaction_postings =
 324                         Map.mapMaybe
 325                          (\p -> case List.filter f $ fmap (Chart.Charted c) p of
 326                                  [] -> Nothing
 327                                  ps -> Just $ fmap Chart.charted ps)
 328                          (transaction_postings t)
 329                  }
 330
 331 -- | Return a 'Map.Map' associating
 332 --   the given 'Transaction's with their respective 'Date'.
 333 transaction_by_Date :: [Transaction] -> (Compose (Map Date) []) Transaction
 334 transaction_by_Date =
 335         Compose .
 336         Map.fromListWith (flip mappend) .
 337         List.map (\t -> (fst $ transaction_dates t, [t]))
 338
 339 -- * Type 'Journal'
 340
 341 data Journal j
 342  = Journal
 343  { journal_amount_styles  :: !Styles
 344  , journal_chart          :: Chart
 345  , journal_file           :: FilePath
 346  , journal_includes       :: [Journal j]
 347  , journal_last_read_time :: Date
 348  , journal_content        :: !j
 349  } deriving (Data, Eq, Show, Typeable)
 350
 351 instance Functor Journal where
 352         fmap f j@Journal{journal_includes, journal_content} =
 353                 j{ journal_content  = f journal_content
 354                  , journal_includes = fmap (fmap f) journal_includes
 355                  }
 356
 357 journal :: Monoid j => Journal j
 358 journal =
 359         Journal
 360          { journal_amount_styles  = mempty
 361          , journal_chart          = mempty
 362          , journal_file           = mempty
 363          , journal_includes       = mempty
 364          , journal_last_read_time = Date.nil
 365          , journal_content        = mempty
 366          }
 367
 368 instance Monoid j => Monoid (Journal j) where
 369         mempty = journal
 370         mappend x y =
 371                 Journal
 372                  { journal_amount_styles  = journal_amount_styles x `mappend` journal_amount_styles y
 373                  , journal_chart          = journal_chart x `mappend` journal_chart y
 374                  , journal_file           = mempty
 375                  , journal_includes       = journal_includes x `mappend` journal_includes y
 376                  , journal_last_read_time = journal_last_read_time x `min` journal_last_read_time y
 377                  , journal_content        = journal_content x `mappend` journal_content y
 378                  }
 379
 380 instance NFData j => NFData (Journal j) where
 381         rnf
 382          Journal
 383          { journal_amount_styles
 384          , journal_chart
 385          , journal_file
 386          , journal_includes
 387          , journal_last_read_time
 388          , journal_content
 389          } =
 390                 rnf journal_amount_styles `seq`
 391                 rnf journal_chart `seq`
 392                 rnf journal_file `seq`
 393                 rnf journal_includes `seq`
 394                 rnf journal_last_read_time `seq`
 395                 rnf journal_content