{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
module ResourceQueue (
    ResourceQueue,
    ResourceQueue.take,
    resource,
    request,
    fulfill,
) where
import Control.Monad.State
import Data.Bifunctor
import Data.Map (Map)
import qualified Data.Map as Map
import Numeric.Natural
import Refined.Unsafe
import Category
import Util
type ResourceQueue a =
    State (Map CategoryName PositiveNumber, Map CategoryName PositiveNumber) a
take :: PositiveNumber -> ResourceQueue [(CategoryName, PositiveNumber)]
take count = do
    (available, requested) <- get
    let (res, remainder) = takeFromQueue count (Map.toAscList available)
    put (Map.fromAscList remainder, requested)
    pure res
resource :: CategoryName -> PositiveNumber -> ResourceQueue ()
resource categoryName count = do
    (available, requested) <- get
    let updateAvailable =
            Map.alter
                ( \case
                    Nothing -> pure count
                    Just x -> pure $ uncheckedAdd x count
                )
                categoryName
                available
    put (updateAvailable, requested)
request :: CategoryName -> PositiveNumber -> ResourceQueue ()
request categoryName count = do
    (available, requested) <- get
    let updateRequested =
            Map.alter
                ( \case
                    Nothing -> pure count
                    Just x -> pure $ uncheckedAdd x count
                )
                categoryName
                requested
    put (available, updateRequested)
fulfill :: PositiveNumber -> ResourceQueue [(CategoryName, PositiveNumber)]
fulfill count = do
    (available, requested) <- get
    let updateRequested = Map.fromAscList remainder
        (res, remainder) = takeFromQueue count $ Map.toAscList requested
    put (available, updateRequested)
    pure res
takeFromQueue ::
    PositiveNumber
    -> [(CategoryName, PositiveNumber)]
    -> ([(CategoryName, PositiveNumber)], [(CategoryName, PositiveNumber)])
takeFromQueue = go mempty . toNumber
  where
    go ::
        [(CategoryName, PositiveNumber)]
        -> Natural
        -> [(CategoryName, PositiveNumber)]
        -> ([(CategoryName, PositiveNumber)], [(CategoryName, PositiveNumber)])
    go acc 0 xs = (acc, xs)
    go acc n (item@(_, count) : xs) = case compare n (toNumber count) of
        LT ->
            go
                (second (const (PositiveNumber $ unsafeRefine n)) item : acc)
                0
                (second (PositiveNumber . unsafeRefine . subtract n . toNumber) item : xs)
        EQ -> go (item : acc) 0 xs
        GT -> go (item : acc) (n - toNumber count) xs
    go acc _ xs = go acc 0 xs

        ResourceQueue,

{-# LANGUAGE TypeApplications #-}

import Control.Monad
import Control.Monad.State

import Data.Bifunctor

import Numeric.Natural

import ResourceQueue

    -> [DiffSig repr]
diffCategory card left right = go mempty (sorter left) (sorter right)

    -> DiffSig repr
diffCategory card left right =
    Diff.chunk
        cardname
        (flip evalState (Map.empty, Map.empty) $ go mempty (sorter left) (sorter right))

        [DiffSig repr]

        [repr (Card -> Maybe Card)]

        -> [DiffSig repr]
    go acc [] [] = acc
    go acc xs [] = acc ++ map (Diff.remove cardname . view Category.name) xs
    go acc [] ys = acc ++ map (uncurry (Diff.add cardname) . mkTuple) ys

        -> ResourceQueue [repr (Card -> Maybe Card)]
    go acc [] [] = pure acc -- TODO: The resourcequeue needs to be emptied and converted to card changes
    go acc xs [] = do
        changes <- forM xs $ \x -> do
            res <- fulfill (x ^. copies)
            let totalFulfilled = sum . map (toNumber @Int . snd) $ res
            when (totalFulfilled < toNumber @Int (x ^. copies)) $
                resource
                    (x ^. Category.name)
                    ( PositiveNumber . unsafeRefine . fromIntegral $
                        toNumber @Int (x ^. copies) - totalFulfilled
                    )
            pure $ map (uncurry (Diff.move (x ^. Category.name))) res
        go (mconcat changes ++ acc) mempty mempty
    go acc [] ys = do
        forM_ ys $ \x -> do
            uncurry request $ mkTuple x
        go acc mempty mempty

            LT -> go (Diff.remove cardname (x ^. Category.name) : acc) xs ly
            EQ ->
                go
                    ( Diff.chunk cardname [Diff.deltaCopies (diffCopies x y) (x ^. Category.name)]
                        : acc
                    )
                    xs
                    ys
            GT -> go (Diff.add cardname (y ^. Category.name) (y ^. copies) : acc) lx ys

            LT -> uncurry resource (mkTuple x) >> go acc xs ly -- We need to add these to the available resources -- go (Diff.remove cardname (x ^. Category.name) : acc) xs ly
            EQ -> do
                let delta = diffCopies x y
                    change 0 = acc
                    change n = Diff.deltaCopies n (x ^. Category.name) : acc
                unless (delta == 0) $ do
                    if delta > 0
                        then
                            resource
                                (x ^. Category.name)
                                (PositiveNumber . unsafeRefine . fromIntegral $ delta)
                        else
                            request
                                (x ^. Category.name)
                                (PositiveNumber . unsafeRefine . abs . fromIntegral $ delta)
                go (change delta) xs ys
            GT -> uncurry resource (mkTuple x) >> go acc lx ys

    diffCopies x y = uncurry (-) $ (y ^. copies, x ^. copies) & both %~ toNumber

    diffCopies x y = uncurry (-) $ (y ^. copies, x ^. copies) & both %~ toNumber @Int