module Payer
  ( getExceedingPayers
  , useIncomesFrom
  , cumulativeIncomesSince
  ) where

import qualified Data.List          as List
import           Data.Map           (Map)
import qualified Data.Map           as M
import qualified Data.Maybe         as Maybe
import           Data.Time          (NominalDiffTime, UTCTime (..))
import qualified Data.Time          as Time
import           Data.Time.Calendar (Day)

import           Common.Model       (ExceedingPayer (..), Income (..),
                                     User (..), UserId)

data Payer = Payer
  { _payer_userId             :: UserId
  , _payer_preIncomePayments  :: Int
  , _payer_postIncomePayments :: Int
  , _payer_incomes            :: [Income]
  }

data PostPaymentPayer = PostPaymentPayer
  { _postPaymentPayer_userId            :: UserId
  , _postPaymentPayer_preIncomePayments :: Int
  , _postPaymentPayer_cumulativeIncome  :: Int
  , _postPaymentPayer_ratio             :: Float
  }

getExceedingPayers :: UTCTime -> [User] -> [Income] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [ExceedingPayer]
getExceedingPayers currentTime users incomes preIncomeRepartition postIncomeRepartition firstPayment =
  let userIds = map _user_id users
      payers = getPayers userIds incomes preIncomeRepartition postIncomeRepartition
      exceedingPayersOnPreIncome =
        exceedingPayersFromAmounts . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) $ payers
      mbSince = useIncomesFrom userIds incomes firstPayment
  in  case mbSince of
        Just since ->
          let postPaymentPayers = map (getPostPaymentPayer currentTime since) payers
              mbMaxRatio = safeMaximum . map _postPaymentPayer_ratio $ postPaymentPayers
          in  case mbMaxRatio of
                Just maxRatio ->
                  exceedingPayersFromAmounts
                    . map (\p -> (_postPaymentPayer_userId p, getFinalDiff maxRatio p))
                    $ postPaymentPayers
                Nothing ->
                  exceedingPayersOnPreIncome
        _ ->
          exceedingPayersOnPreIncome

useIncomesFrom :: [UserId] -> [Income] -> Maybe Day -> Maybe Day
useIncomesFrom userIds incomes firstPayment =
  case (firstPayment, incomeDefinedForAll userIds incomes) of
    (Just d1, Just d2) -> Just (max d1 d2)
    _                  -> Nothing

dayUTCTime :: Day -> UTCTime
dayUTCTime = flip UTCTime (Time.secondsToDiffTime 0)

getPayers :: [UserId] -> [Income] -> Map UserId Int -> Map UserId Int -> [Payer]
getPayers userIds incomes preIncomeRepartition postIncomeRepartition =
  flip map userIds (\userId -> Payer
    { _payer_userId = userId
    , _payer_preIncomePayments = M.findWithDefault 0 userId preIncomeRepartition
    , _payer_postIncomePayments = M.findWithDefault 0 userId postIncomeRepartition
    , _payer_incomes = filter ((==) userId . _income_userId) incomes
    }
  )

exceedingPayersFromAmounts :: [(UserId, Int)] -> [ExceedingPayer]
exceedingPayersFromAmounts userAmounts =
  case mbMinAmount of
    Nothing ->
      []
    Just minAmount ->
      filter (\payer -> _exceedingPayer_amount payer > 0)
        . map (\userAmount ->
           ExceedingPayer
             { _exceedingPayer_userId = fst userAmount
             , _exceedingPayer_amount = snd userAmount - minAmount
             }
        )
        $ userAmounts
  where mbMinAmount = safeMinimum . map snd $ userAmounts

getPostPaymentPayer :: UTCTime -> Day -> Payer -> PostPaymentPayer
getPostPaymentPayer currentTime since payer =
  PostPaymentPayer
    { _postPaymentPayer_userId = _payer_userId payer
    , _postPaymentPayer_preIncomePayments = _payer_preIncomePayments payer
    , _postPaymentPayer_cumulativeIncome = cumulativeIncome
    , _postPaymentPayer_ratio = (fromIntegral . _payer_postIncomePayments $ payer) / (fromIntegral cumulativeIncome)
    }
  where cumulativeIncome = cumulativeIncomesSince currentTime since (_payer_incomes payer)

getFinalDiff :: Float -> PostPaymentPayer -> Int
getFinalDiff maxRatio payer =
  let postIncomeDiff =
        truncate $ -1.0 * (maxRatio - _postPaymentPayer_ratio payer) * (fromIntegral . _postPaymentPayer_cumulativeIncome $ payer)
  in  postIncomeDiff + _postPaymentPayer_preIncomePayments payer

incomeDefinedForAll :: [UserId] -> [Income] -> Maybe Day
incomeDefinedForAll userIds incomes =
  let userIncomes = map (\userId -> filter ((==) userId . _income_userId) $ incomes) userIds
      firstIncomes = map (Maybe.listToMaybe . List.sortOn _income_date) userIncomes
  in  if all Maybe.isJust firstIncomes
        then Maybe.listToMaybe . reverse . List.sort . map _income_date . Maybe.catMaybes $ firstIncomes
        else Nothing

cumulativeIncomesSince :: UTCTime -> Day -> [Income] -> Int
cumulativeIncomesSince currentTime since incomes =
  getCumulativeIncome currentTime (getOrderedIncomesSince since incomes)

getOrderedIncomesSince :: Day -> [Income] -> [Income]
getOrderedIncomesSince since incomes =
  let mbStarterIncome = getIncomeAt since incomes
      orderedIncomesSince = filter (\income -> _income_date income >= since) incomes
  in  (Maybe.maybeToList mbStarterIncome) ++ orderedIncomesSince

getIncomeAt :: Day -> [Income] -> Maybe Income
getIncomeAt day incomes =
  case incomes of
    [x] ->
      if _income_date x < day
        then Just $ x { _income_date = day }
        else Nothing
    x1 : x2 : xs ->
      if _income_date x1 < day && _income_date x2 >= day
        then Just $ x1 { _income_date = day }
        else getIncomeAt day (x2 : xs)
    [] ->
      Nothing

getCumulativeIncome :: UTCTime -> [Income] -> Int
getCumulativeIncome currentTime incomes =
  sum
    . map durationIncome
    . getIncomesWithDuration currentTime
    . List.sortOn incomeTime
    $ incomes

getIncomesWithDuration :: UTCTime -> [Income] -> [(NominalDiffTime, Int)]
getIncomesWithDuration currentTime incomes =
  case incomes of
    [] ->
      []
    [income] ->
      [(Time.diffUTCTime currentTime (incomeTime income), _income_amount income)]
    (income1 : income2 : xs) ->
      (Time.diffUTCTime (incomeTime income2) (incomeTime income1), _income_amount income1) : (getIncomesWithDuration currentTime (income2 : xs))

incomeTime :: Income -> UTCTime
incomeTime = dayUTCTime . _income_date

durationIncome :: (NominalDiffTime, Int) -> Int
durationIncome (duration, income) =
  truncate $ duration * fromIntegral income / (nominalDay * 365 / 12)

nominalDay :: NominalDiffTime
nominalDay = 86400

safeMinimum :: (Ord a) => [a] -> Maybe a
safeMinimum [] = Nothing
safeMinimum xs = Just . minimum $ xs

safeMaximum :: (Ord a) => [a] -> Maybe a
safeMaximum [] = Nothing
safeMaximum xs = Just . maximum $ xs