lib/Hcompta/Format/Ledger/Journal.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE LambdaCase #-}
   3 {-# LANGUAGE NamedFieldPuns #-}
   4 module Hcompta.Format.Ledger.Journal where
   5
   6 -- import           Control.Applicative ((<$>))
   7 import           Data.Data
   8 import qualified Data.Foldable (foldMap)
   9 import qualified Data.List
  10 import qualified Data.Map.Strict as Data.Map
  11 import           Data.Map.Strict (Map)
  12 import qualified Data.Monoid (getFirst, First(..))
  13 import           Data.Monoid (Monoid, mappend)
  14 import qualified Data.Time.Clock       as Time
  15 import qualified Data.Time.Clock.POSIX as Time
  16 import           Data.Typeable ()
  17
  18 import qualified Hcompta.Model as Model
  19 import qualified Hcompta.Model.Amount as Amount
  20 import qualified Hcompta.Model.Journal as Model.Journal
  21 import qualified Hcompta.Model.Transaction as Transaction
  22
  23 -- * The 'Journal' type
  24
  25 data Journal
  26  =   Journal
  27  { file :: FilePath
  28  , includes :: [Journal]
  29  -- , historical_prices :: [Amount.Price.Historical]
  30  , last_read_time :: Time.UTCTime
  31  , transactions :: Transaction.By_Date
  32  -- , transaction_periodics :: [Transaction.Periodic]
  33  -- , transaction_modifiers :: [Transaction.Modifier]
  34  , unit_styles :: Map Amount.Unit Amount.Style
  35  } deriving (Data, Eq, Read, Show, Typeable)
  36
  37 nil :: Journal
  38 nil =
  39         Journal
  40          { file = ""
  41          , includes = []
  42          , last_read_time = Time.posixSecondsToUTCTime 0
  43          , transactions = Data.Map.empty
  44          , unit_styles = Data.Map.empty
  45          }
  46
  47 -- * Iterators
  48
  49 -- | Return the given accumulator folded over
  50 --   the given 'Journal' and its 'includes' 'Journal's.
  51 fold :: (Journal -> a -> a) -> Journal -> a -> a
  52 fold f j@Journal{includes} a =
  53         Data.List.foldl (flip (Hcompta.Format.Ledger.Journal.fold f))
  54          (f j a)
  55          includes
  56
  57 -- | Return the first non-'Nothing' value returned by the given function
  58 --   when applied to the given 'Journal' or its 'includes' 'Journal's,
  59 --   with the parent 'Journal's.
  60 find :: (Journal -> Maybe a) -> Journal -> Maybe (a, [Journal])
  61 find f =
  62         (\case
  63          Nothing -> Nothing
  64          Just (a, path) -> Just (a, Data.List.reverse path))
  65         . find_ []
  66         where
  67                 find_ path j@Journal{includes} =
  68                         case f j of
  69                          Just a -> Just (a, path)
  70                          Nothing ->
  71                                 Data.Monoid.getFirst $
  72                                 Data.Foldable.foldMap (Data.Monoid.First . (find_ (j:path))) $
  73                                 includes
  74
  75 -- | Return the given 'Journal' and its 'includes' 'Journal's
  76 --   mapped by the given function.
  77 traverse :: (Journal -> Journal) -> Journal -> Journal
  78 traverse f =
  79         (\case j@Journal{includes} ->
  80                 j{includes=Data.List.map (traverse f) includes})
  81         . f
  82
  83 -- | Return the given accumulator folded with the given function
  84 --   over the given 'Journal' and its 'includes' 'Journal's.
  85 fold_map :: Monoid a => (Journal -> a -> a) -> Journal -> a -> a
  86 fold_map f j@(Journal{includes}) =
  87         (f j) `mappend` Data.Foldable.foldMap (fold_map f) includes
  88
  89 -- | Return the Model.'Model.Journal' derived from the given 'Journal'.
  90 to_Model :: Journal -> Model.Journal
  91 to_Model jour =
  92         Model.Journal.Journal
  93          { Model.Journal.transactions =
  94                 Data.Map.unionsWith (++) $
  95                 flatten transactions $ jour
  96          }
  97         where
  98                 flatten :: (Journal -> a) -> Journal -> [a]
  99                 flatten g j = g j:Data.List.concatMap (flatten g) (includes j)