{-|
  Copyright   :  (C) 2017, Google Inc.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>
-}

{-# LANGUAGE CPP #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module GHC.SrcLoc.Extra where

import Data.Binary
import Data.Hashable                        (Hashable (..))
import GHC.Generics
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc
  (SrcSpan (..), RealSrcLoc, RealSrcSpan, BufSpan (..), BufPos (..), UnhelpfulSpanReason (..),
   mkRealSrcLoc, mkRealSrcSpan,
   realSrcSpanStart, realSrcSpanEnd,
   srcLocFile, srcLocLine, srcLocCol,
   srcSpanFile, srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol)
import GHC.Data.FastString (FastString (..), bytesFS, mkFastStringByteList)
#else
import SrcLoc
  (SrcSpan (..), RealSrcLoc, RealSrcSpan,
   mkRealSrcLoc, mkRealSrcSpan,
   realSrcSpanStart, realSrcSpanEnd,
   srcLocFile, srcLocLine, srcLocCol,
   srcSpanFile, srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol)
import FastString                           (FastString (..), bytesFS, mkFastStringByteList)
#endif


#if MIN_VERSION_ghc(9,0,0)
deriving instance Ord SrcSpan
deriving instance Ord UnhelpfulSpanReason
#endif

deriving instance Generic SrcSpan
instance Hashable SrcSpan

instance Hashable RealSrcSpan where
  hashWithSalt :: Int -> RealSrcSpan -> Int
hashWithSalt Int
salt RealSrcSpan
rss =
    Int -> (FastString, Int, Int, Int, Int) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
rss,RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
rss, RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
rss
                      ,RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
rss, RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
rss)

instance Hashable FastString where
  hashWithSalt :: Int -> FastString -> Int
hashWithSalt Int
salt FastString
fs = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (FastString -> Int
uniq FastString
fs)

instance Binary SrcSpan
instance Binary RealSrcSpan where
  put :: RealSrcSpan -> Put
put RealSrcSpan
r = (RealSrcLoc, RealSrcLoc) -> Put
forall t. Binary t => t -> Put
put (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
r, RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
r)
  get :: Get RealSrcSpan
get = (RealSrcLoc -> RealSrcLoc -> RealSrcSpan)
-> (RealSrcLoc, RealSrcLoc) -> RealSrcSpan
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan ((RealSrcLoc, RealSrcLoc) -> RealSrcSpan)
-> Get (RealSrcLoc, RealSrcLoc) -> Get RealSrcSpan
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RealSrcLoc, RealSrcLoc)
forall t. Binary t => Get t
get

instance Binary RealSrcLoc where
  put :: RealSrcLoc -> Put
put RealSrcLoc
r = (FastString, Int, Int) -> Put
forall t. Binary t => t -> Put
put (RealSrcLoc -> FastString
srcLocFile RealSrcLoc
r, RealSrcLoc -> Int
srcLocLine RealSrcLoc
r, RealSrcLoc -> Int
srcLocCol RealSrcLoc
r)
  get :: Get RealSrcLoc
get = (\(FastString
file,Int
line,Int
col) -> FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
file Int
line Int
col) ((FastString, Int, Int) -> RealSrcLoc)
-> Get (FastString, Int, Int) -> Get RealSrcLoc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (FastString, Int, Int)
forall t. Binary t => Get t
get

instance Binary FastString where
  put :: FastString -> Put
put FastString
str = ByteString -> Put
forall t. Binary t => t -> Put
put (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ FastString -> ByteString
bytesFS FastString
str
  get :: Get FastString
get = [Word8] -> FastString
mkFastStringByteList ([Word8] -> FastString) -> Get [Word8] -> Get FastString
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word8]
forall t. Binary t => Get t
get

#if MIN_VERSION_ghc(9,0,0)
deriving instance Generic BufPos
instance Binary BufPos
instance Hashable BufPos

deriving instance Generic UnhelpfulSpanReason
instance Binary UnhelpfulSpanReason
instance Hashable UnhelpfulSpanReason

deriving instance Generic BufSpan
instance Binary BufSpan
instance Hashable BufSpan
#endif