<commit_before>{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
module Hledger.Dashboard.Journal where

import           Control.Lens hiding ((...), singular)
import           Data.AdditiveGroup
import           Data.Foldable
import           Data.Monoid
import qualified Data.Map.Strict as M
import           Data.Time.Calendar (
  Day,
  addDays,
  addGregorianMonthsClip,
  addGregorianYearsClip,
  fromGregorian,
  toGregorian)
import           Data.Time.Calendar.WeekDate (fromWeekDate, toWeekDate)
import           Hledger.Dashboard.Account (Accounts)
import           Hledger.Dashboard.Currency (Currency)
import           Numeric.Interval

data ReportingInterval = Day | Week | Month | Year
  deriving (Eq, Ord, Show, Enum, Bounded)

enumerate :: (Enum a, Bounded a) => [a]
enumerate = enumFromTo minBound maxBound

-- | Journal contains accounts for various reporting periods
data Journal = Journal {
  _intervals :: M.Map (Day, ReportingInterval) Accounts,
  _firstDay :: Maybe Day
}

makeLenses ''Journal

-- TODO: instance Monoid Journal

-- | Create a journal with a single entry
singleton :: Day -> Accounts -> Journal
singleton d a = Journal is fd where
  is = M.fromList $ fmap (flip (,) a) $ fmap (\i -> (begin i d, i)) enumerate
  fd = Just d

-- | Get the first day of the interval containing the given day
-- | If the interval is `Day` then `begin` and `end` both evaluate to `id`
begin :: ReportingInterval -> Day -> Day
begin i d = case i of
  Day -> d
  Week -> fromWeekDate y w 1 where
    (y, w, _) = toWeekDate d
  Month -> fromGregorian y m 1 where
    (y, m, _) = toGregorian d
  Year -> fromGregorian y 1 1 where
    (y, _, _) = toGregorian d

-- | Get the last day of the interval containing the given day
-- | If the interval is `Day` then `begin` and `end` both evaluate to `id`
end :: ReportingInterval -> Day -> Day
end i d = case i of
  Day -> d
  Week -> pred $ fromWeekDate y w 1 where
    (y, w, _) = toWeekDate d'
    d' = addDays 7 d
  Month -> pred $ fromGregorian y m 1 where
    (y, m, _) = toGregorian $ addGregorianMonthsClip 1 d
  Year -> pred $ fromGregorian y 1 1 where
    (y, _, _) = toGregorian $ addGregorianYearsClip 1 d

-- | Get all intervals starting at a given date
startingAt :: Day -> [ReportingInterval]
startingAt d = takeWhile ((==) d . flip begin d) enumerate
<commit_msg>Pointfree<commit_after>{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
module Hledger.Dashboard.Journal where

import           Control.Lens hiding ((...), singular)
import           Data.AdditiveGroup
import           Data.Foldable
import           Data.Monoid
import qualified Data.Map.Strict as M
import           Data.Time.Calendar (
  Day,
  addDays,
  addGregorianMonthsClip,
  addGregorianYearsClip,
  fromGregorian,
  toGregorian)
import           Data.Time.Calendar.WeekDate (fromWeekDate, toWeekDate)
import           Hledger.Dashboard.Account (Accounts)
import           Hledger.Dashboard.Currency (Currency)
import           Numeric.Interval

data ReportingInterval = Day | Week | Month | Year
  deriving (Eq, Ord, Show, Enum, Bounded)

enumerate :: (Enum a, Bounded a) => [a]
enumerate = enumFromTo minBound maxBound

-- | Journal contains accounts for various reporting periods
data Journal = Journal {
  _intervals :: M.Map (Day, ReportingInterval) Accounts,
  _firstDay :: Maybe Day
}

makeLenses ''Journal

-- TODO: instance Monoid Journal

-- | Create a journal with a single entry
singleton :: Day -> Accounts -> Journal
singleton d a = Journal is fd where
  is = M.fromList $ fmap (flip (,) a . ((,) <$> flip begin d <*> id)) enumerate
  fd = Just d

-- | Get the first day of the interval containing the given day
-- | If the interval is `Day` then `begin` and `end` both evaluate to `id`
begin :: ReportingInterval -> Day -> Day
begin i d = case i of
  Day -> d
  Week -> fromWeekDate y w 1 where
    (y, w, _) = toWeekDate d
  Month -> fromGregorian y m 1 where
    (y, m, _) = toGregorian d
  Year -> fromGregorian y 1 1 where
    (y, _, _) = toGregorian d

-- | Get the last day of the interval containing the given day
-- | If the interval is `Day` then `begin` and `end` both evaluate to `id`
end :: ReportingInterval -> Day -> Day
end i d = case i of
  Day -> d
  Week -> pred $ fromWeekDate y w 1 where
    (y, w, _) = toWeekDate d'
    d' = addDays 7 d
  Month -> pred $ fromGregorian y m 1 where
    (y, m, _) = toGregorian $ addGregorianMonthsClip 1 d
  Year -> pred $ fromGregorian y 1 1 where
    (y, _, _) = toGregorian $ addGregorianYearsClip 1 d

-- | Get all intervals starting at a given date
startingAt :: Day -> [ReportingInterval]
startingAt d = takeWhile ((==) d . flip begin d) enumerate

{'fraction_non_alphanumeric': 0.1011068539804172, 'fraction_numerical': 0.004682843763303533, 'mean_word_length': 2.96875, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 38, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5374043', 'n_tokens_mistral': 1558, 'n_tokens_neox': 1462, 'n_words': 562}