{-# LANGUAGE DerivingStrategies #-}

module Patch
  ( Patch (..),
    parse,
  )
where

import Prettyprinter (pretty)
import Control.Exception (throw)
import Data.Binary (Binary (..))
import Data.Text qualified as T
import Exception qualified as E
import GHC.Generics (Generic)
import Render ((<<<))
import Render qualified as P
import Text.Diff.Extra ()
import Text.Diff.Parse qualified as D
import Text.Diff.Parse.Types qualified as D

newtype Patch = Patch
  { fileDeltas :: D.FileDeltas
  }
  deriving (Show, Generic)
  deriving newtype (Binary)

parse :: T.Text -> Patch
parse = either (throw . E.InvalidDiff) Patch . D.parseDiff

instance P.Render Patch where
  render = P.render . P.Detailed

instance P.Render (P.Detailed Patch) where
  render (P.Detailed (Patch {..})) =
    P.vsep (map prettyFileDelta fileDeltas) <<< ("\n" :: T.Text)
    where
      prettyFileDelta (D.FileDelta {..}) =
        ("diff --git " <> fileDeltaSourceFile <> " " <> fileDeltaDestFile <> "\n")
          <<< (prettySourceFile fileDeltaSourceFile <<< ("\n" :: T.Text))
          <<< (prettyDestFile fileDeltaDestFile <<< ("\n" :: T.Text))
          <<< prettyContent fileDeltaContent
      prettySourceFile file = P.styled [P.bold] $ ("---" :: T.Text) <<< file
      prettyDestFile file = P.styled [P.bold] $ ("+++" :: T.Text) <<< file
      prettyContent D.Binary = P.emptyDoc
      prettyContent (D.Hunks hunks) = P.vsep (map prettyHunk hunks)
      prettyHunk (D.Hunk {..}) =
        P.styled [P.color P.Blue] $
          (prettySourceRange hunkSourceRange hunkDestRange <<< ("\n" :: T.Text))
            <<< P.vsep (map prettyLine hunkLines)
      prettySourceRange srcRange dstRange =
        ("" :: T.Text) <<< ("@@ -" <> prettyRange srcRange <> " +" <> prettyRange dstRange <> " @@")
      prettyRange (D.Range line lineNo) =
        T.pack (show line) <> "," <> T.pack (show lineNo)
      prettyLine (D.Line {..}) =
        case lineAnnotation of
          D.Added -> P.styled [P.color P.Green] $ P.plus @P.AnsiStyle <> pretty lineContent
          D.Removed -> P.styled [P.color P.Red] $ P.minus @P.AnsiStyle <> pretty lineContent
          D.Context -> P.styled [P.color P.White] $ P.space @P.AnsiStyle <> pretty lineContent
          D.Comment -> P.styled [P.color P.White] $ P.hash @P.AnsiStyle <> pretty lineContent