eventTime,

    leEventTime,

        fromThyme $ e ^. eventTime,

        fromThyme $ e ^. leEventTime,

        fromThyme $ e ^. eventTime,

        fromThyme $ e ^. leEventTime,

        fromThyme $ e ^. eventTime,

        fromThyme $ e ^. leEventTime,

        pure (aid, set (logEntry . event . eventTime) t kle, "amend_event_time")

        pure (aid, set (logEntry . event . leEventTime) t kle, "amend_event_time")

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}

import Control.Lens ((.~), (^.), makeClassy, makeLenses, makePrisms, view)

import Control.Lens (Lens', (.~), (^.), makeClassy, makeLenses, makePrisms, view)

class HasEventTime a where
  eventTime :: Lens' a C.UTCTime
instance HasEventTime C.UTCTime where
  eventTime = id

  = StartWork {_eventTime :: !C.UTCTime}
  | StopWork {_eventTime :: !C.UTCTime}

  = StartWork {_leEventTime :: !C.UTCTime}
  | StopWork {_leEventTime :: !C.UTCTime}

makeLenses ''LogEvent

makeLenses ''LogEvent

instance HasEventTime LogEvent where
  eventTime = leEventTime

instance {-# OVERLAPPABLE #-} HasLogEntry a => HasEventTime a where
  eventTime = event . leEventTime

newtype WorkIndex t = WorkIndex (Map CreditTo (NonEmpty (Interval t))) deriving (Show, Eq)

newtype WorkIndex t = WorkIndex (Map CreditTo (NonEmpty (Interval t)))
  deriving (Show, Eq, Functor)

workCredit :: (Foldable f, HasLogEntry le) => DepF -> C.UTCTime -> f (Interval le) -> (NDT, NDT)

workCredit :: (Foldable f, HasEventTime le) => DepF -> C.UTCTime -> f (Interval le) -> (NDT, NDT)

  bimap getSum getSum $ F.foldMap ((Sum . ilen &&& Sum . depf ptime) . fmap (view $ event . eventTime)) ivals

  bimap getSum getSum $ F.foldMap ((Sum . ilen &&& Sum . depf ptime) . fmap (view eventTime)) ivals

payouts :: forall le. (HasLogEntry le) => DepF -> C.UTCTime -> WorkIndex le -> WorkShares

payouts :: forall le. (HasEventTime le) => DepF -> C.UTCTime -> WorkIndex le -> WorkShares

          case extension (view (event . eventTime) <$> ival) logEvent of

          case extension (view (event . leEventTime) <$> ival) logEvent of

{-# LANGUAGE TypeApplications #-}

import Prelude hiding (head, tail)

import Aftok.Types (UserId (..))
import Control.Lens ((^.))

import Aftok.Types (UserId (..), DepreciationFunction(..))
import Control.Lens ((^.), view, to)

import Data.Maybe (fromJust)
import Data.List (head, tail)
import Data.Ratio ((%))

genIntervals :: Gen (L.NonEmpty I.Interval)

genIntervals :: Gen (L.NonEmpty (I.Interval T.UTCTime))

      buildIntervals :: T.UTCTime -> [NominalDiffTime] -> [I.Interval]

      buildIntervals :: T.UTCTime -> [NominalDiffTime] -> [I.Interval T.UTCTime]

genWorkIndex :: Gen WorkIndex

genWorkIndex :: Gen (WorkIndex T.UTCTime)

  let recordGen :: Gen (CreditTo, L.NonEmpty I.Interval)

  let recordGen :: Gen (CreditTo, L.NonEmpty (I.Interval T.UTCTime))

          testIntervals :: [(CreditTo, I.Interval)]

          testIntervals :: [(CreditTo, I.Interval T.UTCTime)]

      (workIndex testLogEntries) `shouldBe` expected

          actual = view eventTime <$> workIndex id testLogEntries
      actual `shouldBe` expected

         in workIndex logEntries
              `shouldBe` (WorkIndex $ fmap (L.reverse . L.sort) widx')

            expected = (WorkIndex $ fmap (L.reverse . L.sort) widx')
            actual = view eventTime <$> workIndex id logEntries
         in actual `shouldBe` expected
    it "computes correct work shares" $ do
      [u0, u1, u2] <- fmap CreditToUser . take 3 <$> sample' (UserId <$> genUUID)
      let initTime = toThyme . fromJust $ parseISO8601 "2014-01-01T00:08:00Z"
          len = fromInteger @NominalDiffTime 360
          timestamps = iterate (addUTCTime len) initTime
          intervals =
            fmap (uncurry I.Interval . snd)
            . filter (\i -> fst i `mod` 2 == 0)
            $ ([(0 :: Int)..] `zip` (timestamps `zip` tail timestamps))
          widx = WorkIndex $ M.fromList
            [ (u0, L.fromList $ take 10 intervals)
            , (u1, L.fromList $ take 30 intervals)
            , (u2, L.fromList $ take 120 intervals)
            ]
          -- for this test we'll be entirely within undepreciated period
          depf = toDepF $ LinearDepreciation 180 1800
          evalTime = I._start . head $ drop 120 intervals

          shares = payouts depf evalTime widx
      (shares ^. loggedTotal `shouldBe` (fromInteger @NominalDiffTime (360 * 160)))
      (shares ^. creditToShares . to (fromJust . M.lookup u0) . wsShare) `shouldBe` (10 % 160)
      (shares ^. creditToShares . to (fromJust . M.lookup u1) . wsShare) `shouldBe` (30 % 160)
      (shares ^. creditToShares . to (fromJust . M.lookup u2) . wsShare) `shouldBe` (120 % 160)