-- | This module contains types that relate to the positions of things
-- in source files, and allow tagging of those things with locations
module SrcLoc (
	-- * SrcLoc
	SrcLoc,			-- Abstract

        -- ** Constructing SrcLoc
	mkSrcLoc, mkGeneralSrcLoc,

	noSrcLoc, 		-- "I'm sorry, I haven't a clue"
	generatedSrcLoc,	-- Code generated within the compiler
	interactiveSrcLoc,	-- Code from an interactive session

        advanceSrcLoc,

	-- ** Unsafely deconstructing SrcLoc
	-- These are dubious exports, because they crash on some inputs
	srcLocFile,		-- return the file name part
	srcLocLine,		-- return the line part
	srcLocCol,		-- return the column part
	
	-- ** Misc. operations on SrcLoc
	pprDefnLoc,
	
        -- ** Predicates on SrcLoc
        isGoodSrcLoc,

        -- * SrcSpan
	SrcSpan,		-- Abstract

        -- ** Constructing SrcSpan
	mkGeneralSrcSpan, mkSrcSpan, 
	noSrcSpan, 
	wiredInSrcSpan,		-- Something wired into the compiler
	srcLocSpan,
	combineSrcSpans,
	
	-- ** Deconstructing SrcSpan
	srcSpanStart, srcSpanEnd,
	srcSpanFileName_maybe,

	-- ** Unsafely deconstructing SrcSpan
	-- These are dubious exports, because they crash on some inputs
	srcSpanFile, 
        srcSpanStartLine, srcSpanEndLine, 
        srcSpanStartCol, srcSpanEndCol,

        -- ** Predicates on SrcSpan
        isGoodSrcSpan, isOneLineSpan,

        -- * Located
	Located(..), 
	
	-- ** Constructing Located
	noLoc,
        mkGeneralLocated,
	
	-- ** Deconstructing Located
	getLoc, unLoc, 
	
	-- ** Combining and comparing Located values
	eqLocated, cmpLocated, combineLocs, addCLoc,
        leftmost_smallest, leftmost_largest, rightmost, 
        spans, isSubspanOf
    ) where

#include "Typeable.h"

import Util
import Outputable
import FastString

import Data.Bits
import Data.Data

-- | Represents a single point within a file
data SrcLoc
  = SrcLoc	FastString	-- A precise location (file name)
		{-# UNPACK #-} !Int		-- line number, begins at 1
		{-# UNPACK #-} !Int		-- column number, begins at 1
  | UnhelpfulLoc FastString	-- Just a general indication

mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
mkSrcLoc x line col = SrcLoc x line col

-- | Built-in "bad" 'SrcLoc' values for particular locations
noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
noSrcLoc	  = UnhelpfulLoc (fsLit "<no location info>")
generatedSrcLoc   = UnhelpfulLoc (fsLit "<compiler-generated code>")
interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive session>")

-- | Creates a "bad" 'SrcLoc' that has no detailed information about its location
mkGeneralSrcLoc :: FastString -> SrcLoc
mkGeneralSrcLoc = UnhelpfulLoc 

-- | "Good" 'SrcLoc's have precise information about their location
isGoodSrcLoc :: SrcLoc -> Bool
isGoodSrcLoc (SrcLoc _ _ _) = True
isGoodSrcLoc _other         = False

-- | Gives the filename of the 'SrcLoc' if it is available, otherwise returns a dummy value
srcLocFile :: SrcLoc -> FastString
srcLocFile (SrcLoc fname _ _) = fname
srcLocFile _other	      = (fsLit "<unknown file")

-- | Raises an error when used on a "bad" 'SrcLoc'
srcLocLine :: SrcLoc -> Int
srcLocLine (SrcLoc _ l _) = l
srcLocLine (UnhelpfulLoc s) = pprPanic "srcLocLine" (ftext s)

-- | Raises an error when used on a "bad" 'SrcLoc'
srcLocCol :: SrcLoc -> Int
srcLocCol (SrcLoc _ _ c) = c
srcLocCol (UnhelpfulLoc s) = pprPanic "srcLocCol" (ftext s)

-- | Move the 'SrcLoc' down by one line if the character is a newline,
-- to the next 8-char tabstop if it is a tab, and across by one
-- character in any other case
advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f  (l + 1) 1
advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f  l (((((c - 1) `shiftR` 3) + 1)
                                                  `shiftL` 3) + 1)
advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
advanceSrcLoc loc            _    = loc -- Better than nothing

-- SrcLoc is an instance of Ord so that we can sort error messages easily
instance Eq SrcLoc where
  loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
		   EQ     -> True
		   _other -> False

instance Ord SrcLoc where
  compare = cmpSrcLoc
   
cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering
cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
cmpSrcLoc (UnhelpfulLoc _)  _other            = LT

cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)      
  = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
cmpSrcLoc (SrcLoc _ _ _) _other = GT

instance Outputable SrcLoc where
    ppr (SrcLoc src_path src_line src_col)
      = getPprStyle $ \ sty ->
        if userStyle sty || debugStyle sty then
            hcat [ pprFastFilePath src_path, char ':', 
                   int src_line,
                   char ':', int src_col
                 ]
        else
            hcat [text "{-# LINE ", int src_line, space,
                  char '\"', pprFastFilePath src_path, text " #-}"]

    ppr (UnhelpfulLoc s)  = ftext s

INSTANCE_TYPEABLE0(SrcSpan,srcSpanTc,"SrcSpan")

instance Data SrcSpan where
  -- don't traverse?
  toConstr _   = abstractConstr "SrcSpan"
  gunfold _ _  = error "gunfold"
  dataTypeOf _ = mkNoRepType "SrcSpan"

{- |
A SrcSpan delimits a portion of a text file.  It could be represented
by a pair of (line,column) coordinates, but in fact we optimise
slightly by using more compact representations for single-line and
zero-length spans, both of which are quite common.

The end position is defined to be the column /after/ the end of the
span.  That is, a span of (1,1)-(1,2) is one character long, and a
span of (1,1)-(1,1) is zero characters long.
-}
data SrcSpan
  = SrcSpanOneLine 		-- a common case: a single line
	{ srcSpanFile     :: !FastString,
	  srcSpanLine     :: {-# UNPACK #-} !Int,
	  srcSpanSCol     :: {-# UNPACK #-} !Int,
	  srcSpanECol     :: {-# UNPACK #-} !Int
	}

  | SrcSpanMultiLine
	{ srcSpanFile	  :: !FastString,
	  srcSpanSLine    :: {-# UNPACK #-} !Int,
	  srcSpanSCol	  :: {-# UNPACK #-} !Int,
	  srcSpanELine    :: {-# UNPACK #-} !Int,
	  srcSpanECol     :: {-# UNPACK #-} !Int
	}

  | SrcSpanPoint
	{ srcSpanFile	  :: !FastString,
	  srcSpanLine	  :: {-# UNPACK #-} !Int,
	  srcSpanCol      :: {-# UNPACK #-} !Int
	}

  | UnhelpfulSpan !FastString	-- Just a general indication
				-- also used to indicate an empty span

#ifdef DEBUG
  deriving (Eq, Show)	-- Show is used by Lexer.x, becuase we
			-- derive Show for Token
#else
  deriving Eq
#endif

-- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
noSrcSpan, wiredInSrcSpan :: SrcSpan
noSrcSpan      = UnhelpfulSpan (fsLit "<no location info>")
wiredInSrcSpan = UnhelpfulSpan (fsLit "<wired into compiler>")

-- | Create a "bad" 'SrcSpan' that has not location information
mkGeneralSrcSpan :: FastString -> SrcSpan
mkGeneralSrcSpan = UnhelpfulSpan

-- | Create a 'SrcSpan' corresponding to a single point
srcLocSpan :: SrcLoc -> SrcSpan
srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col

-- | Create a 'SrcSpan' between two points in a file
mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
mkSrcSpan loc1 loc2
  | line1 == line2 = if col1 == col2
			then SrcSpanPoint file line1 col1
			else SrcSpanOneLine file line1 col1 col2
  | otherwise      = SrcSpanMultiLine file line1 col1 line2 col2
  where
	line1 = srcLocLine loc1
	line2 = srcLocLine loc2
	col1 = srcLocCol loc1
	col2 = srcLocCol loc2
	file = srcLocFile loc1

-- | Combines two 'SrcSpan' into one that spans at least all the characters
-- within both spans. Assumes the "file" part is the same in both inputs
combineSrcSpans	:: SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans	(UnhelpfulSpan _) r = r -- this seems more useful
combineSrcSpans	l (UnhelpfulSpan _) = l
combineSrcSpans	start end 
 = case line1 `compare` line2 of
     EQ -> case col1 `compare` col2 of
		EQ -> SrcSpanPoint file line1 col1
		LT -> SrcSpanOneLine file line1 col1 col2
		GT -> SrcSpanOneLine file line1 col2 col1
     LT -> SrcSpanMultiLine file line1 col1 line2 col2
     GT -> SrcSpanMultiLine file line2 col2 line1 col1
  where
	line1 = srcSpanStartLine start
	col1  = srcSpanStartCol start
	line2 = srcSpanEndLine end
	col2  = srcSpanEndCol end
	file  = srcSpanFile start

-- | Test if a 'SrcSpan' is "good", i.e. has precise location information
isGoodSrcSpan :: SrcSpan -> Bool
isGoodSrcSpan SrcSpanOneLine{} = True
isGoodSrcSpan SrcSpanMultiLine{} = True
isGoodSrcSpan SrcSpanPoint{} = True
isGoodSrcSpan _ = False

isOneLineSpan :: SrcSpan -> Bool
-- ^ True if the span is known to straddle only one line.
-- For "bad" 'SrcSpan', it returns False
isOneLineSpan s
  | isGoodSrcSpan s = srcSpanStartLine s == srcSpanEndLine s
  | otherwise	    = False		

-- | Raises an error when used on a "bad" 'SrcSpan'
srcSpanStartLine :: SrcSpan -> Int
-- | Raises an error when used on a "bad" 'SrcSpan'
srcSpanEndLine :: SrcSpan -> Int
-- | Raises an error when used on a "bad" 'SrcSpan'
srcSpanStartCol :: SrcSpan -> Int
-- | Raises an error when used on a "bad" 'SrcSpan'
srcSpanEndCol :: SrcSpan -> Int

srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
srcSpanStartLine _ = panic "SrcLoc.srcSpanStartLine"

srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
srcSpanEndLine _ = panic "SrcLoc.srcSpanEndLine"

srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
srcSpanStartCol _ = panic "SrcLoc.srcSpanStartCol"

srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"

-- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanStart :: SrcSpan -> SrcLoc
-- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanEnd :: SrcSpan -> SrcLoc

srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
srcSpanStart s = mkSrcLoc (srcSpanFile s) 
			  (srcSpanStartLine s)
		 	  (srcSpanStartCol s)

srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
srcSpanEnd s = 
  mkSrcLoc (srcSpanFile s) 
	   (srcSpanEndLine s)
 	   (srcSpanEndCol s)

-- | Obtains the filename for a 'SrcSpan' if it is "good"
srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
srcSpanFileName_maybe (SrcSpanOneLine { srcSpanFile = nm })   = Just nm
srcSpanFileName_maybe (SrcSpanMultiLine { srcSpanFile = nm }) = Just nm
srcSpanFileName_maybe (SrcSpanPoint { srcSpanFile = nm})      = Just nm
srcSpanFileName_maybe _                                       = Nothing

-- We want to order SrcSpans first by the start point, then by the end point.
instance Ord SrcSpan where
  a `compare` b = 
     (srcSpanStart a `compare` srcSpanStart b) `thenCmp` 
     (srcSpanEnd   a `compare` srcSpanEnd   b)


instance Outputable SrcSpan where
    ppr span
      = getPprStyle $ \ sty ->
        if userStyle sty || debugStyle sty then
           pprUserSpan True span
        else
           hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
                 char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]

pprUserSpan :: Bool -> SrcSpan -> SDoc
pprUserSpan show_path (SrcSpanOneLine src_path line start_col end_col)
  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
         , int line, char ':', int start_col
         , ppUnless (end_col - start_col <= 1)
                    (char '-' <> int (end_col-1)) 
	    -- For single-character or point spans, we just 
	    -- output the starting column number
         ]
	  

pprUserSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
	 , parens (int sline <> char ',' <>  int scol)
	 , char '-'
	 , parens (int eline <> char ',' <>  
	   	   if ecol == 0 then int ecol else int (ecol-1))
	 ]

pprUserSpan show_path (SrcSpanPoint src_path line col)
  = hcat [ ppWhen show_path $ (pprFastFilePath src_path <> colon)
         , int line, char ':', int col ]

pprUserSpan _ (UnhelpfulSpan s)  = ftext s

pprDefnLoc :: SrcSpan -> SDoc
-- ^ Pretty prints information about the 'SrcSpan' in the style "defined at ..."
pprDefnLoc loc
  | isGoodSrcSpan loc = ptext (sLit "Defined at") <+> ppr loc
  | otherwise	      = ppr loc

-- | We attach SrcSpans to lots of things, so let's have a datatype for it.
data Located e = L SrcSpan e
  deriving (Eq, Ord, Typeable, Data)

unLoc :: Located e -> e
unLoc (L _ e) = e

getLoc :: Located e -> SrcSpan
getLoc (L l _) = l

noLoc :: e -> Located e
noLoc e = L noSrcSpan e

mkGeneralLocated :: String -> e -> Located e
mkGeneralLocated s e = L (mkGeneralSrcSpan (fsLit s)) e

combineLocs :: Located a -> Located b -> SrcSpan
combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)

-- | Combine locations from two 'Located' things and add them to a third thing
addCLoc :: Located a -> Located b -> c -> Located c
addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c

-- not clear whether to add a general Eq instance, but this is useful sometimes:

-- | Tests whether the two located things are equal
eqLocated :: Eq a => Located a -> Located a -> Bool
eqLocated a b = unLoc a == unLoc b

-- not clear whether to add a general Ord instance, but this is useful sometimes:

-- | Tests the ordering of the two located things
cmpLocated :: Ord a => Located a -> Located a -> Ordering
cmpLocated a b = unLoc a `compare` unLoc b

instance Functor Located where
  fmap f (L l e) = L l (f e)

instance Outputable e => Outputable (Located e) where
  ppr (L l e) = ifPprDebug (braces (pprUserSpan False l)) $$ ppr e
		-- Print spans without the file name etc

-- | Alternative strategies for ordering 'SrcSpan's
leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
rightmost            = flip compare
leftmost_smallest    = compare 
leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
                                `thenCmp`
                       (srcSpanEnd b `compare` srcSpanEnd a)


-- | Determines whether a span encloses a given line and column index
spans :: SrcSpan -> (Int, Int) -> Bool
spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
   where loc = mkSrcLoc (srcSpanFile span) l c

-- | Determines whether a span is enclosed by another one
isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other
            -> SrcSpan -- ^ The span it may be enclosed by
            -> Bool
isSubspanOf src parent 
    | srcSpanFileName_maybe parent /= srcSpanFileName_maybe src = False
    | otherwise = srcSpanStart parent <= srcSpanStart src &&
                  srcSpanEnd parent   >= srcSpanEnd src