SrcLoc.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

import GHC.Types.SrcLoc
import GHC.Utils.Outputable

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

-- 'stripLocs x' is 'x' with all contained source locs replaced by
-- 'noSrcSpan'.
stripLocs :: Data from => from -> from
stripLocs = transformBi (const noSrcSpan)

-- 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 (Outputable, Eq)
instance Default SrcSpanD where def = SrcSpanD noSrcSpan

-- 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 a) (SrcSpanD b) =
  case a of
    RealSrcSpan a1 _ ->
      case b of
        RealSrcSpan b1 _ ->
          a1 `compareRealSrcSpans` b1
        _ -> EQ -- error "'Duplicate.hs' invariant error: can't compare unhelpful spans"
    _ -> EQ -- error "'Duplicate.hs' invariant error: can't compare unhelpful spans"
compareRealSrcSpans a b =
  let (a1, a2, a3, a4, a5) = (srcSpanFile a, srcSpanStartLine a, srcSpanStartCol a, srcSpanEndLine a, srcSpanEndCol a)
      (b1, b2, b3, b4, b5) = (srcSpanFile b, srcSpanStartLine b, srcSpanStartCol b, srcSpanEndLine b, srcSpanEndCol b)
  in compare (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5)
instance Ord SrcSpanD where compare = compareSrcSpans