    {-# LANGUAGE RankNTypes #-}

    -- | Diffing GHC ASTs modulo span positions.
    module Ormolu.Diff
      ( Diff (..),
        diffParseResult,
        diffText,
      )
    where

    import Data.ByteString (ByteString)
    import Data.Generics
    import Data.Text (Text)
    import qualified Data.Text as T
    import qualified FastString as GHC
    import GHC
    import Ormolu.Imports (normalizeImports)
    import Ormolu.Parser.CommentStream
    import Ormolu.Parser.Result
    import Ormolu.Utils

    -- | Result of comparing two 'ParseResult's.
    data Diff
      = -- | Two parse results are the same
        Same
      | -- | Two parse results differ
        Different [SrcSpan]

    instance Semigroup Diff where
      Same <> :: Diff -> Diff -> Diff
    <> a :: Diff
    a = Diff
    a
      a :: Diff
    a <> Same = Diff
    a
      Different xs :: [SrcSpan]
    xs <> Different ys :: [SrcSpan]
    ys = [SrcSpan] -> Diff
    Different ([SrcSpan]
    xs [SrcSpan] -> [SrcSpan] -> [SrcSpan]
    forall a. [a] -> [a] -> [a]
    ++ [SrcSpan]
    ys)

    instance Monoid Diff where
      mempty :: Diff
    mempty = Diff
    Same

    -- | Return 'Diff' of two 'ParseResult's.
    diffParseResult :: ParseResult -> ParseResult -> Diff
    diffParseResult :: ParseResult -> ParseResult -> Diff
    diffParseResult
      ParseResult
        { prCommentStream :: ParseResult -> CommentStream
    prCommentStream = CommentStream
    cstream0,
          prParsedSource :: ParseResult -> HsModule GhcPs
    prParsedSource = HsModule GhcPs
    hs0
        }
      ParseResult
        { prCommentStream :: ParseResult -> CommentStream
    prCommentStream = CommentStream
    cstream1,
          prParsedSource :: ParseResult -> HsModule GhcPs
    prParsedSource = HsModule GhcPs
    hs1
        } =
        CommentStream -> CommentStream -> Diff
    forall a. Data a => a -> a -> Diff
    matchIgnoringSrcSpans CommentStream
    cstream0 CommentStream
    cstream1
          Diff -> Diff -> Diff
    forall a. Semigroup a => a -> a -> a
    <> HsModule GhcPs -> HsModule GhcPs -> Diff
    forall a. Data a => a -> a -> Diff
    matchIgnoringSrcSpans
            HsModule GhcPs
    hs0 {hsmodImports :: [LImportDecl GhcPs]
    hsmodImports = [LImportDecl GhcPs] -> [LImportDecl GhcPs]
    normalizeImports (HsModule GhcPs -> [LImportDecl GhcPs]
    forall pass. HsModule pass -> [LImportDecl pass]
    hsmodImports HsModule GhcPs
    hs0)}
            HsModule GhcPs
    hs1 {hsmodImports :: [LImportDecl GhcPs]
    hsmodImports = [LImportDecl GhcPs] -> [LImportDecl GhcPs]
    normalizeImports (HsModule GhcPs -> [LImportDecl GhcPs]
    forall pass. HsModule pass -> [LImportDecl pass]
    hsmodImports HsModule GhcPs
    hs1)}

    -- | Compare two values for equality disregarding differences in 'SrcSpan's
    -- and the ordering of import lists.
    matchIgnoringSrcSpans :: Data a => a -> a -> Diff
    matchIgnoringSrcSpans :: a -> a -> Diff
    matchIgnoringSrcSpans = a -> a -> Diff
    GenericQ (GenericQ Diff)
    genericQuery
      where
        genericQuery :: GenericQ (GenericQ Diff)
        genericQuery :: a -> GenericQ Diff
    genericQuery x :: a
    x y :: a
    y
          -- 'ByteString' implements 'Data' instance manually and does not
          -- implement 'toConstr', so we have to deal with it in a special way.
          | Just x' :: ByteString
    x' <- a -> Maybe ByteString
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    x,
            Just y' :: ByteString
    y' <- a -> Maybe ByteString
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    y =
            if ByteString
    x' ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == (ByteString
    y' :: ByteString)
              then Diff
    Same
              else [SrcSpan] -> Diff
    Different []
          | a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf a
    x TypeRep -> TypeRep -> Bool
    forall a. Eq a => a -> a -> Bool
    == a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf a
    y,
            a -> Constr
    forall a. Data a => a -> Constr
    toConstr a
    x Constr -> Constr -> Bool
    forall a. Eq a => a -> a -> Bool
    == a -> Constr
    forall a. Data a => a -> Constr
    toConstr a
    y =
            [Diff] -> Diff
    forall a. Monoid a => [a] -> a
    mconcat ([Diff] -> Diff) -> [Diff] -> Diff
    forall a b. (a -> b) -> a -> b
    $
              GenericQ (GenericQ Diff) -> a -> a -> [Diff]
    forall r. GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
    gzipWithQ
                ( a -> a -> Diff
    GenericQ (GenericQ Diff)
    genericQuery
                    (a -> a -> Diff) -> (SrcSpan -> a -> Diff) -> a -> a -> Diff
    forall a b q.
    (Typeable a, Typeable b) =>
    (a -> q) -> (b -> q) -> a -> q
    `extQ` SrcSpan -> a -> Diff
    SrcSpan -> GenericQ Diff
    srcSpanEq
                    (a -> a -> Diff) -> (Comment -> a -> Diff) -> a -> a -> Diff
    forall a b q.
    (Typeable a, Typeable b) =>
    (a -> q) -> (b -> q) -> a -> q
    `extQ` Comment -> a -> Diff
    Comment -> GenericQ Diff
    commentEq
                    (a -> a -> Diff) -> (SourceText -> a -> Diff) -> a -> a -> Diff
    forall a b q.
    (Typeable a, Typeable b) =>
    (a -> q) -> (b -> q) -> a -> q
    `extQ` SourceText -> a -> Diff
    SourceText -> GenericQ Diff
    sourceTextEq
                    (a -> a -> Diff) -> (HsDocString -> a -> Diff) -> a -> a -> Diff
    forall a b q.
    (Typeable a, Typeable b) =>
    (a -> q) -> (b -> q) -> a -> q
    `extQ` HsDocString -> a -> Diff
    HsDocString -> GenericQ Diff
    hsDocStringEq
                    (a -> a -> Diff)
    -> (ImportDeclQualifiedStyle -> a -> Diff) -> a -> a -> Diff
    forall a b q.
    (Typeable a, Typeable b) =>
    (a -> q) -> (b -> q) -> a -> q
    `extQ` ImportDeclQualifiedStyle -> a -> Diff
    ImportDeclQualifiedStyle -> GenericQ Diff
    importDeclQualifiedStyleEq
                    (a -> a -> Diff)
    -> (forall d1 d2.
        (Data d1, Data d2) =>
        GenLocated d1 d2 -> a -> Diff)
    -> a
    -> a
    -> Diff
    forall d (t :: * -> * -> *) q.
    (Data d, Typeable t) =>
    (d -> q)
    -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
    `ext2Q` forall d1 d2. (Data d1, Data d2) => GenLocated d1 d2 -> a -> Diff
    forall e0 e1.
    (Data e0, Data e1) =>
    GenLocated e0 e1 -> GenericQ Diff
    forLocated
                )
                a
    x
                a
    y
          | Bool
    otherwise = [SrcSpan] -> Diff
    Different []
        srcSpanEq :: SrcSpan -> GenericQ Diff
        srcSpanEq :: SrcSpan -> GenericQ Diff
    srcSpanEq _ _ = Diff
    Same
        commentEq :: Comment -> GenericQ Diff
        commentEq :: Comment -> GenericQ Diff
    commentEq (Comment _ x :: NonEmpty String
    x) d :: a
    d =
          case a -> Maybe Comment
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    d :: Maybe Comment of
            Nothing -> [SrcSpan] -> Diff
    Different []
            Just (Comment _ y :: NonEmpty String
    y) ->
              if NonEmpty String
    x NonEmpty String -> NonEmpty String -> Bool
    forall a. Eq a => a -> a -> Bool
    == NonEmpty String
    y
                then Diff
    Same
                else [SrcSpan] -> Diff
    Different []
        sourceTextEq :: SourceText -> GenericQ Diff
        sourceTextEq :: SourceText -> GenericQ Diff
    sourceTextEq _ _ = Diff
    Same
        importDeclQualifiedStyleEq :: ImportDeclQualifiedStyle -> GenericQ Diff
        importDeclQualifiedStyleEq :: ImportDeclQualifiedStyle -> GenericQ Diff
    importDeclQualifiedStyleEq d0 :: ImportDeclQualifiedStyle
    d0 d1' :: a
    d1' =
          case (ImportDeclQualifiedStyle
    d0, a -> Maybe ImportDeclQualifiedStyle
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    d1' :: Maybe ImportDeclQualifiedStyle) of
            (x :: ImportDeclQualifiedStyle
    x, Just x' :: ImportDeclQualifiedStyle
    x') | ImportDeclQualifiedStyle
    x ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
    forall a. Eq a => a -> a -> Bool
    == ImportDeclQualifiedStyle
    x' -> Diff
    Same
            (QualifiedPre, Just QualifiedPost) -> Diff
    Same
            (QualifiedPost, Just QualifiedPre) -> Diff
    Same
            _ -> [SrcSpan] -> Diff
    Different []
        hsDocStringEq :: HsDocString -> GenericQ Diff
        hsDocStringEq :: HsDocString -> GenericQ Diff
    hsDocStringEq str0 :: HsDocString
    str0 str1' :: a
    str1' =
          case a -> Maybe HsDocString
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    str1' :: Maybe HsDocString of
            Nothing -> [SrcSpan] -> Diff
    Different []
            Just str1 :: HsDocString
    str1 ->
              if HsDocString -> [Text]
    splitDocString HsDocString
    str0 [Text] -> [Text] -> Bool
    forall a. Eq a => a -> a -> Bool
    == HsDocString -> [Text]
    splitDocString HsDocString
    str1
                then Diff
    Same
                else [SrcSpan] -> Diff
    Different []
        forLocated ::
          (Data e0, Data e1) =>
          GenLocated e0 e1 ->
          GenericQ Diff
        forLocated :: GenLocated e0 e1 -> GenericQ Diff
    forLocated x :: GenLocated e0 e1
    x@(L mspn :: e0
    mspn _) y :: a
    y =
          (Diff -> Diff)
    -> (SrcSpan -> Diff -> Diff) -> Maybe SrcSpan -> Diff -> Diff
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Diff -> Diff
    forall a. a -> a
    id SrcSpan -> Diff -> Diff
    appendSpan (e0 -> Maybe SrcSpan
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast e0
    mspn) (GenLocated e0 e1 -> a -> Diff
    GenericQ (GenericQ Diff)
    genericQuery GenLocated e0 e1
    x a
    y)
        appendSpan :: SrcSpan -> Diff -> Diff
        appendSpan :: SrcSpan -> Diff -> Diff
    appendSpan s :: SrcSpan
    s (Different ss :: [SrcSpan]
    ss) | Bool
    fresh Bool -> Bool -> Bool
    && Bool
    helpful = [SrcSpan] -> Diff
    Different (SrcSpan
    s SrcSpan -> [SrcSpan] -> [SrcSpan]
    forall a. a -> [a] -> [a]
    : [SrcSpan]
    ss)
          where
            fresh :: Bool
    fresh = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ (SrcSpan -> Bool) -> [SrcSpan] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (SrcSpan -> SrcSpan -> Bool
    `isSubspanOf` SrcSpan
    s) [SrcSpan]
    ss
            helpful :: Bool
    helpful = SrcSpan -> Bool
    isGoodSrcSpan SrcSpan
    s
        appendSpan _ d :: Diff
    d = Diff
    d

    -- | Diff two texts and return the location they start to differ, alongside
    -- with excerpts around that location.
    diffText ::
      -- | Text before
      Text ->
      -- | Text after
      Text ->
      -- | Path to use to construct 'GHC.RealSrcLoc'
      FilePath ->
      Maybe (GHC.RealSrcLoc, Text, Text)
    diffText :: Text -> Text -> String -> Maybe (RealSrcLoc, Text, Text)
    diffText left :: Text
    left right :: Text
    right fp :: String
    fp =
      case (Int, Int, Int) -> Text -> Text -> Maybe (Int, Int, Int)
    forall a b c.
    (Num a, Num b, Num c) =>
    (a, b, c) -> Text -> Text -> Maybe (a, b, c)
    go (0, 0, 0) Text
    left Text
    right of
        Nothing -> Maybe (RealSrcLoc, Text, Text)
    forall a. Maybe a
    Nothing
        Just (row :: Int
    row, col :: Int
    col, loc :: Int
    loc) ->
          (RealSrcLoc, Text, Text) -> Maybe (RealSrcLoc, Text, Text)
    forall a. a -> Maybe a
    Just
            ( FastString -> Int -> Int -> RealSrcLoc
    GHC.mkRealSrcLoc (String -> FastString
    GHC.mkFastString String
    fp) Int
    row Int
    col,
              Int -> Text -> Text
    getSpan Int
    loc Text
    left,
              Int -> Text -> Text
    getSpan Int
    loc Text
    right
            )
      where
        go :: (a, b, c) -> Text -> Text -> Maybe (a, b, c)
    go (row :: a
    row, col :: b
    col, loc :: c
    loc) t1 :: Text
    t1 t2 :: Text
    t2 =
          case (Text -> Maybe (Char, Text)
    T.uncons Text
    t1, Text -> Maybe (Char, Text)
    T.uncons Text
    t2) of
            -- both text empty, all good
            (Nothing, Nothing) ->
              Maybe (a, b, c)
    forall a. Maybe a
    Nothing
            -- first chars are the same, adjust position and recurse
            (Just (c1 :: Char
    c1, r1 :: Text
    r1), Just (c2 :: Char
    c2, r2 :: Text
    r2))
              | Char
    c1 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c2 ->
                let (row' :: a
    row', col' :: b
    col', loc' :: c
    loc') =
                      if Char
    c1 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\n'
                        then (a
    row a -> a -> a
    forall a. Num a => a -> a -> a
    + 1, 0, c
    loc c -> c -> c
    forall a. Num a => a -> a -> a
    + 1)
                        else (a
    row, b
    col b -> b -> b
    forall a. Num a => a -> a -> a
    + 1, c
    loc c -> c -> c
    forall a. Num a => a -> a -> a
    + 1)
                 in (a, b, c) -> Text -> Text -> Maybe (a, b, c)
    go (a
    row', b
    col', c
    loc') Text
    r1 Text
    r2
            -- something is different, return the position
            _ ->
              (a, b, c) -> Maybe (a, b, c)
    forall a. a -> Maybe a
    Just (a
    row, b
    col, c
    loc)
        getSpan :: Int -> Text -> Text
    getSpan loc :: Int
    loc = Int -> Text -> Text
    T.take 20 (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Text -> Text
    T.drop (Int
    loc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 10)