    {-# LANGUAGE ImportQualifiedPost #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}

    module GHC.Util.SrcLoc (
        getAncLoc
      , stripLocs
      , SrcSpanD(..)
      ) where

    import GHC.Parser.Annotation
    import GHC.Types.SrcLoc
    import GHC.Utils.Outputable
    import GHC.Data.FastString
    import GHC.Data.Strict qualified

    import Data.Default
    import Data.Data
    import Data.Generics.Uniplate.DataOnly

    -- Get the 'SrcSpan' out of a value located by an 'NoCommentsLocation'
    -- (e.g. comments).
    getAncLoc :: GenLocated NoCommentsLocation a -> SrcSpan
    getAncLoc :: forall a. GenLocated NoCommentsLocation a -> SrcSpan
    getAncLoc GenLocated NoCommentsLocation a
    o = RealSrcSpan -> Maybe BufSpan -> SrcSpan
    RealSrcSpan (NoCommentsLocation -> RealSrcSpan
    forall a. EpaLocation' a -> RealSrcSpan
    GHC.Parser.Annotation.epaLocationRealSrcSpan (GenLocated NoCommentsLocation a -> NoCommentsLocation
    forall l e. GenLocated l e -> l
    GHC.Types.SrcLoc.getLoc GenLocated NoCommentsLocation a
    o)) Maybe BufSpan
    forall a. Maybe a
    GHC.Data.Strict.Nothing

    -- 'stripLocs x' is 'x' with all contained source locs replaced by
    -- 'noSrcSpan'.
    stripLocs :: Data from => from -> from
    stripLocs :: forall from. Data from => from -> from
    stripLocs =
      (RealSrcSpan -> RealSrcSpan) -> from -> from
    forall from to. Biplate from to => (to -> to) -> from -> from
    transformBi (RealSrcSpan -> RealSrcSpan -> RealSrcSpan
    forall a b. a -> b -> a
    const RealSrcSpan
    dummySpan) (from -> from) -> (from -> from) -> from -> from
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SrcSpan -> SrcSpan) -> from -> from
    forall from to. Biplate from to => (to -> to) -> from -> from
    transformBi (SrcSpan -> SrcSpan -> SrcSpan
    forall a b. a -> b -> a
    const SrcSpan
    noSrcSpan)
      where
        dummyLoc :: RealSrcLoc
    dummyLoc = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc (String -> FastString
    fsLit String
    "dummy") Int
    1 Int
    1
        dummySpan :: RealSrcSpan
    dummySpan = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
    mkRealSrcSpan RealSrcLoc
    dummyLoc RealSrcLoc
    dummyLoc

    -- TODO (2020-10-03, SF): Maybe move the following definitions down to
    -- ghc-lib-parser at some point.

    -- 'Duplicates.hs' requires 'SrcSpan' be in 'Default' and 'Ord'.
    newtype SrcSpanD = SrcSpanD SrcSpan
      deriving (SrcSpanD -> SDoc
    (SrcSpanD -> SDoc) -> Outputable SrcSpanD
    forall a. (a -> SDoc) -> Outputable a
    $cppr :: SrcSpanD -> SDoc
    ppr :: SrcSpanD -> SDoc
    Outputable, SrcSpanD -> SrcSpanD -> Bool
    (SrcSpanD -> SrcSpanD -> Bool)
    -> (SrcSpanD -> SrcSpanD -> Bool) -> Eq SrcSpanD
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SrcSpanD -> SrcSpanD -> Bool
    == :: SrcSpanD -> SrcSpanD -> Bool
    $c/= :: SrcSpanD -> SrcSpanD -> Bool
    /= :: SrcSpanD -> SrcSpanD -> Bool
    Eq)
    instance Default SrcSpanD where def :: SrcSpanD
    def = SrcSpan -> SrcSpanD
    SrcSpanD SrcSpan
    noSrcSpan

    newtype FastStringD = FastStringD FastString
      deriving FastStringD -> FastStringD -> Bool
    (FastStringD -> FastStringD -> Bool)
    -> (FastStringD -> FastStringD -> Bool) -> Eq FastStringD
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FastStringD -> FastStringD -> Bool
    == :: FastStringD -> FastStringD -> Bool
    $c/= :: FastStringD -> FastStringD -> Bool
    /= :: FastStringD -> FastStringD -> Bool
    Eq
    compareFastStrings :: FastStringD -> FastStringD -> Ordering
    compareFastStrings (FastStringD FastString
    f) (FastStringD FastString
    g) =
      FastString -> FastString -> Ordering
    lexicalCompareFS FastString
    f FastString
    g
    instance Ord FastStringD where compare :: FastStringD -> FastStringD -> Ordering
    compare = FastStringD -> FastStringD -> Ordering
    compareFastStrings

    -- SrcSpan no longer provides 'Ord' so we are forced to roll our own.
    --
    -- Note: This implementation chooses that any span compares 'EQ to an
    -- 'UnhelpfulSpan'. Ex falso quodlibet!
    compareSrcSpans :: SrcSpanD -> SrcSpanD -> Ordering
    compareSrcSpans (SrcSpanD SrcSpan
    a) (SrcSpanD SrcSpan
    b) =
      case SrcSpan
    a of
        RealSrcSpan RealSrcSpan
    a1 Maybe BufSpan
    _ ->
          case SrcSpan
    b of
            RealSrcSpan RealSrcSpan
    b1 Maybe BufSpan
    _ ->
              RealSrcSpan
    a1 RealSrcSpan -> RealSrcSpan -> Ordering
    `compareRealSrcSpans` RealSrcSpan
    b1
            SrcSpan
    _ -> Ordering
    EQ -- error "'Duplicate.hs' invariant error: can't compare unhelpful spans"
        SrcSpan
    _ -> Ordering
    EQ -- error "'Duplicate.hs' invariant error: can't compare unhelpful spans"
    compareRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> Ordering
    compareRealSrcSpans RealSrcSpan
    a RealSrcSpan
    b =
      let (LexicalFastString
    a1, Int
    a2, Int
    a3, Int
    a4, Int
    a5) = (FastString -> LexicalFastString
    LexicalFastString (RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    a), RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    a, RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    a, RealSrcSpan -> Int
    srcSpanEndLine RealSrcSpan
    a, RealSrcSpan -> Int
    srcSpanEndCol RealSrcSpan
    a)
          (LexicalFastString
    b1, Int
    b2, Int
    b3, Int
    b4, Int
    b5) = (FastString -> LexicalFastString
    LexicalFastString (RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    b), RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    b, RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    b, RealSrcSpan -> Int
    srcSpanEndLine RealSrcSpan
    b, RealSrcSpan -> Int
    srcSpanEndCol RealSrcSpan
    b)
      in (LexicalFastString, Int, Int, Int, Int)
    -> (LexicalFastString, Int, Int, Int, Int) -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (LexicalFastString
    a1, Int
    a2, Int
    a3, Int
    a4, Int
    a5) (LexicalFastString
    b1, Int
    b2, Int
    b3, Int
    b4, Int
    b5)
    instance Ord SrcSpanD where compare :: SrcSpanD -> SrcSpanD -> Ordering
    compare = SrcSpanD -> SrcSpanD -> Ordering
    compareSrcSpans