{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Repr.StateRep (
    -- * Types
    CardMap,
    R,

    -- * Selectors
    eval,
) where

import Data.Either.Extra
import Data.Functor
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.Text (Text)

import Control.Lens

import Refined
import Refined.Unsafe

import Deck.Category as Category
import Deck.Deck as Deck
import Deck.Diff
import Util

type CardMap = Map Text Card

newtype R a = R {unR :: a}
    deriving stock (Show, Functor)
    deriving (Applicative, Monad) via Identity

type instance DeckRep R = Map Text Card

instance DeckSYM R where
    empty = R mempty

    deck = R

    add cardname initialCategory initialCopies decklist =
        R $ Map.alter updateCard (toText cardname) $ unR decklist
      where
        updateCard = \case
            Nothing -> Just $ mkCard cardname initialCategory initialCopies
            Just x ->
                case x ^? categories . ix (toText initialCategory) of
                    Nothing ->
                        pure $
                            x
                                & categories . at (toText initialCategory)
                                    ?~ Category initialCategory initialCopies
                    Just y ->
                        let mergedCategory = (y & copies %~ uncheckedAdd initialCopies)
                         in pure $ x & categories . at (toText initialCategory) ?~ mergedCategory

    delete cardName decklist = R $ Map.delete (toText cardName) (unR decklist)

instance HunkSYM R where
    hunk cardToChange changes decklist =
        R $
            let updateCard oldCard = foldl (\acc x -> acc >>= unR x) (Just oldCard) changes
             in unR decklist & ix (toText cardToChange) %~ (\x -> fromMaybe x (updateCard x))

    move old new numCopies = R $ \card ->
        let oldCopies = card ^? categories . ix (toText old) . copies
            copiesToMove = oldCopies <&> min numCopies
            updateCopies x =
                Map.alter
                    ( \case
                        Nothing -> Just $ Category new x
                        Just oldCategory -> Just $ oldCategory & copies %~ uncheckedAdd x
                    )
                    (toText new)
                    (card ^. categories)
            updateOld =
                Map.update
                    ( \y ->
                        let (l, r) = (toNumber @Int $ y ^. copies, toNumber @Int numCopies)
                         in if l <= r
                                then Nothing
                                else
                                    Just $ y & copies .~ (PositiveNumber . unsafeRefine . fromIntegral $ (l - r))
                    )
                    (toText old)
         in copiesToMove
                <&> (\x -> x & categories %~ updateOld)
                    . (\x -> card & categories .~ updateCopies x)

    deltaCopies delta category = R $ \card ->
        let deltaNorm = PositiveNumber <$> (newCopies >>= eitherToMaybe . refine . fromIntegral)
            newCopies =
                card ^? categories . ix (toText category) . copies
                    <&> (+ delta) . toNumber @Int
            update x = card & (categories . ix (toText category) . copies) .~ x
         in update <$> deltaNorm

eval :: R a -> a
eval = unR