module Model.Payer
  ( getOrderedExceedingPayers
  ) where

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

import           Common.Model (Income (..), IncomeId, Payment (..), User (..),
                               UserId)

type Users = Map UserId User

type Payers = Map UserId Payer

type Incomes = Map IncomeId Income

type Payments = [Payment]

data Payer = Payer
  { preIncomePaymentSum  :: Int
  , postIncomePaymentSum :: Int
  , _incomes             :: [Income]
  }

data PostPaymentPayer = PostPaymentPayer
  { _preIncomePaymentSum :: Int
  , _cumulativeIncome    :: Int
  , ratio                :: Float
  }

data ExceedingPayer = ExceedingPayer
  { _userId :: UserId
  , amount  :: Int
  } deriving (Show)

getOrderedExceedingPayers :: UTCTime -> [User] -> [Income] -> Payments -> [ExceedingPayer]
getOrderedExceedingPayers currentTime users incomes payments =
  let usersMap = Map.fromList . map (\user -> (_user_id user, user)) $ users
      incomesMap = Map.fromList . map (\income -> (_income_id income, income)) $ incomes
      payers = getPayers currentTime usersMap incomesMap payments
      exceedingPayersOnPreIncome =
        exceedingPayersFromAmounts
          . Map.toList
          . Map.map preIncomePaymentSum
          $ payers
      mbSince = useIncomesFrom usersMap incomesMap payments
  in  case mbSince of
        Just since ->
          let postPaymentPayers = Map.map (getPostPaymentPayer currentTime since) payers
              mbMaxRatio =
                safeMaximum
                  . map (ratio . snd)
                  . Map.toList
                  $ postPaymentPayers
          in  case mbMaxRatio of
                Just maxRatio ->
                  exceedingPayersFromAmounts
                    . Map.toList
                    . Map.map (getFinalDiff maxRatio)
                    $ postPaymentPayers
                Nothing ->
                  exceedingPayersOnPreIncome
        _ ->
          exceedingPayersOnPreIncome

useIncomesFrom :: Users -> Incomes -> Payments -> Maybe UTCTime
useIncomesFrom users incomes payments =
  let firstPaymentTime = safeHead . List.sort . map paymentTime $ payments
      mbIncomeTime = incomeDefinedForAll (Map.keys users) 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 -> Users -> Incomes -> Payments -> Payers
getPayers currentTime users incomes payments =
  let userIds = Map.keys users
      incomesDefined = incomeDefinedForAll userIds incomes
  in  Map.fromList
        . map (\userId ->
            ( userId
            , Payer
                { preIncomePaymentSum =
                    totalPayments
                      (\p -> paymentTime p < (Maybe.fromMaybe currentTime incomesDefined))
                      userId
                      payments
                , postIncomePaymentSum =
                    totalPayments
                      (\p ->
                        case incomesDefined of
                          Nothing -> False
                          Just t  -> paymentTime p >= t
                      )
                      userId
                      payments
                , _incomes = filter ((==) userId . _income_userId) (Map.elems incomes)
                }
            )
        )
        $ userIds

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

getPostPaymentPayer :: UTCTime -> UTCTime -> Payer -> PostPaymentPayer
getPostPaymentPayer currentTime since payer =
  PostPaymentPayer
    { _preIncomePaymentSum = preIncomePaymentSum payer
    , _cumulativeIncome = cumulativeIncome
    , ratio = (fromIntegral . postIncomePaymentSum $ payer) / (fromIntegral cumulativeIncome)
    }
  where cumulativeIncome = cumulativeIncomesSince currentTime since (_incomes payer)

getFinalDiff :: Float -> PostPaymentPayer -> Int
getFinalDiff maxRatio payer =
  let postIncomeDiff =
        truncate $ -1.0 * (maxRatio - ratio payer) * (fromIntegral . _cumulativeIncome $ payer)
  in  postIncomeDiff + _preIncomePaymentSum payer

incomeDefinedForAll :: [UserId] -> Incomes -> Maybe UTCTime
incomeDefinedForAll userIds incomes =
  let userIncomes = map (\userId -> filter ((==) userId . _income_userId) . Map.elems $ 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 -> Payments -> Int
totalPayments paymentFilter userId payments =
  sum
    . map _payment_cost
    . filter (\payment -> paymentFilter payment && _payment_user payment == userId)
    $ payments