module Common.Model.Payer
  ( getExceedingPayers
  , useIncomesFrom
  , cumulativeIncomesSince
  ) where

import qualified Data.List                   as List
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 (ExceedingPayer (..))
import           Common.Model.Income         (Income (..))
import           Common.Model.Payment        (Payment (..))
import           Common.Model.User           (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] -> [Payment] -> [ExceedingPayer]
getExceedingPayers currentTime users incomes payments =
  let userIds = map _user_id users
      payers = getPayers userIds incomes payments
      exceedingPayersOnPreIncome =
        exceedingPayersFromAmounts . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) $ payers
      firstPayment = safeHead . List.sort . map _payment_date $ payments
      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] -> [Payment] -> [Payer]
getPayers userIds incomes payments =
  let incomesDefined = incomeDefinedForAll userIds incomes
  in  flip map userIds (\userId -> Payer
        { _payer_userId = userId
        , _payer_preIncomePayments =
            totalPayments
              (\p ->
                case incomesDefined of
                  Just d ->
                    _payment_date p < d

                  Nothing ->
                    True
              )
              userId
              payments
        , _payer_postIncomePayments =
            totalPayments
              (\p ->
                case incomesDefined of
                  Nothing -> False
                  Just t  -> _payment_date p >= t
              )
              userId
              payments
        , _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 (safeHead . List.sortOn _income_date) userIncomes
  in  if all Maybe.isJust firstIncomes
        then safeHead . 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

safeHead :: [a] -> Maybe a
safeHead []      = Nothing
safeHead (x : _) = Just x

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

totalPayments :: (Payment -> Bool) -> UserId -> [Payment] -> Int
totalPayments paymentFilter userId payments =
  sum
    . map _payment_cost
    . filter (\payment -> paymentFilter payment && _payment_user payment == userId)
    $ payments