lib/Hcompta/Format/Ledger/Journal.hs

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