{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Repr.DiffRep (
    DiffR (..),
    view,
    eval,
) where

import Data.Text (Text)
import qualified Data.Text as Text

import Deck.Diff
import Util
import Repr.Interpret

newtype DiffR a = DiffR {unDiffR :: Text}
    deriving stock (Show)

type instance DeckRep DiffR = Text

quote :: Text -> Text
quote content =
    let escaped = Text.replace "\"" "\\\"" content
     in flip Text.snoc '"' . Text.cons '"' $ escaped

line :: [Text] -> Text
line = Text.stripEnd . Text.unlines

instance DeckSYM DiffR where
    empty = DiffR Text.empty

    deck = DiffR

    add cardname categoryname cardCopies content =
        let entry =
                [ "A"
                , quote $ toText cardname
                , Text.pack . show . toNumber @Int $ cardCopies
                , quote $ toText categoryname
                ]
         in DiffR $ line [unDiffR content, Text.intercalate " " entry]

    delete cardname content =
        let entry =
                Text.intercalate
                    " "
                    [ "D"
                    , quote $ toText cardname
                    ]
         in DiffR $ line [unDiffR content, entry]

instance HunkSYM DiffR where
    hunk cardname changes content =
        let header = Text.append ">> " (quote $ toText cardname)
            hunks = line $ foldr (\ch acc -> Text.append "  " (unDiffR ch) : acc ) mempty changes
         in DiffR $ Text.unlines [Text.stripEnd $ unDiffR content, Text.empty, header, hunks]

    move fromCategory toCategory count =
        let entry =
                Text.intercalate
                    " "
                    [ "M"
                    , Text.pack . show . toNumber @Int $ count
                    , quote $ toText fromCategory
                    , quote $ toText toCategory
                    ]
         in DiffR entry

    deltaCopies delta categoryname =
        let entry =
                Text.intercalate
                    " "
                    [ Text.pack . show $ delta
                    , quote $ toText categoryname
                    ]
         in DiffR entry

view :: DiffR a -> Text
view = unDiffR

eval :: (Traversable t) => t (DiffR (DeckRep DiffR) -> DiffR (DeckRep DiffR)) -> DiffR (DeckRep DiffR)
eval = evalMany