module Common.Model.Payer
  ( ExceedingPayer(..)
  , 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           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
  }

data ExceedingPayer = ExceedingPayer
  { _exceedingPayer_userId :: UserId
  , _exceedingPayer_amount :: Int
  } deriving (Show)

getExceedingPayers :: UTCTime -> [User] -> [Income] -> [Payment] -> [ExceedingPayer]
getExceedingPayers currentTime users incomes payments =
  let userIds = map _user_id users
      payers = getPayers currentTime userIds incomes payments
      exceedingPayersOnPreIncome =
        exceedingPayersFromAmounts . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) $ payers
      mbSince = useIncomesFrom userIds incomes payments
  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] -> [Payment] -> Maybe UTCTime
useIncomesFrom userIds incomes payments =
  let firstPaymentTime = safeHead . List.sort . map paymentTime $ payments
      mbIncomeTime = incomeDefinedForAll userIds incomes
  in  case (firstPaymentTime, mbIncomeTime) of
        (Just t1, Just t2) -> Just (max t1 t2)
        _                  -> Nothing

paymentTime :: Payment -> UTCTime
paymentTime = flip UTCTime (Time.secondsToDiffTime 0) . _payment_date

getPayers :: UTCTime -> [UserId] -> [Income] -> [Payment] -> [Payer]
getPayers currentTime userIds incomes payments =
  let incomesDefined = incomeDefinedForAll userIds incomes
  in  flip map userIds (\userId -> Payer
        { _payer_userId = userId
        , _payer_preIncomePayments =
            totalPayments
              (\p -> paymentTime p < (Maybe.fromMaybe currentTime incomesDefined))
              userId
              payments
        , _payer_postIncomePayments =
            totalPayments
              (\p ->
                case incomesDefined of
                  Nothing -> False
                  Just t  -> paymentTime 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 -> UTCTime -> 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 UTCTime
incomeDefinedForAll userIds incomes =
  let userIncomes = map (\userId -> filter ((==) userId . _income_userId) $ incomes) userIds
      firstIncomes = map (safeHead . List.sortOn incomeTime) userIncomes
  in  if all Maybe.isJust firstIncomes
        then safeHead . reverse . List.sort . map incomeTime . Maybe.catMaybes $ firstIncomes
        else Nothing

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

getOrderedIncomesSince :: UTCTime -> [Income] -> [Income]
getOrderedIncomesSince time incomes =
  let mbStarterIncome = getIncomeAt time incomes
      orderedIncomesSince = filter (\income -> incomeTime income >= time) incomes
  in  (Maybe.maybeToList mbStarterIncome) ++ orderedIncomesSince

getIncomeAt :: UTCTime -> [Income] -> Maybe Income
getIncomeAt time incomes =
  case incomes of
    [x] ->
      if incomeTime x < time
        then Just $ x { _income_date = utctDay time }
        else Nothing
    x1 : x2 : xs ->
      if incomeTime x1 < time && incomeTime x2 >= time
        then Just $ x1 { _income_date = utctDay time }
        else getIncomeAt time (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 = flip UTCTime (Time.secondsToDiffTime 0) . _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