{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}

module GHC.Util (
    module GHC.Util.View
  , module GHC.Util.FreeVars
  , module GHC.Util.ApiAnnotation
  , module GHC.Util.HsDecl
  , module GHC.Util.HsExpr
  , module GHC.Util.SrcLoc
  , module GHC.Util.DynFlags
  , module GHC.Util.Scope
  , module GHC.Util.Unify
  , parsePragmasIntoDynFlags
  , fileToModule
  , pattern SrcSpan, srcSpanFilename, srcSpanStartLine', srcSpanStartColumn, srcSpanEndLine', srcSpanEndColumn
  , pattern SrcLoc, srcFilename, srcLine, srcColumn
  , showSrcSpan,
  ) where

import GHC.Util.View
import GHC.Util.FreeVars
import GHC.Util.ApiAnnotation
import GHC.Util.HsExpr
import GHC.Util.HsDecl
import GHC.Util.SrcLoc
import GHC.Util.DynFlags
import GHC.Util.Scope
import GHC.Util.Unify

import Language.Haskell.GhclibParserEx.GHC.Parser (parseFile)
import Language.Haskell.GhclibParserEx.GHC.Driver.Session (parsePragmasIntoDynFlags)
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable

import GHC.Hs
import GHC.Parser.Lexer
import GHC.Types.SrcLoc
import GHC.Driver.Session
import GHC.Data.FastString

import System.FilePath
import Language.Preprocessor.Unlit

fileToModule :: FilePath -> String -> DynFlags -> ParseResult (Located HsModule)
fileToModule :: FilePath -> FilePath -> DynFlags -> ParseResult (Located HsModule)
fileToModule FilePath
filename FilePath
str DynFlags
flags =
  FilePath -> DynFlags -> FilePath -> ParseResult (Located HsModule)
parseFile FilePath
filename DynFlags
flags
    (if FilePath -> FilePath
takeExtension FilePath
filename FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
".lhs" then FilePath
str else FilePath -> FilePath -> FilePath
unlit FilePath
filename FilePath
str)

{-# COMPLETE SrcSpan #-}
-- | The \"Line'\" thing is because there is already e.g. 'SrcLoc.srcSpanStartLine'
pattern SrcSpan :: String -> Int -> Int -> Int -> Int -> SrcSpan
pattern $mSrcSpan :: forall r.
SrcSpan
-> (FilePath -> Int -> Int -> Int -> Int -> r) -> (Void# -> r) -> r
SrcSpan
  { SrcSpan -> FilePath
srcSpanFilename
  , SrcSpan -> Int
srcSpanStartLine'
  , SrcSpan -> Int
srcSpanStartColumn
  , SrcSpan -> Int
srcSpanEndLine'
  , SrcSpan -> Int
srcSpanEndColumn
  }
  <-
    (toOldeSpan ->
      ( srcSpanFilename
      , srcSpanStartLine'
      , srcSpanStartColumn
      , srcSpanEndLine'
      , srcSpanEndColumn
      ))

toOldeSpan :: SrcSpan -> (String, Int, Int, Int, Int)
toOldeSpan :: SrcSpan -> (FilePath, Int, Int, Int, Int)
toOldeSpan (RealSrcSpan RealSrcSpan
span Maybe BufSpan
_) =
  ( FastString -> FilePath
unpackFS (FastString -> FilePath) -> FastString -> FilePath
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
span
  , RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
span
  , RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
span
  , RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
span
  , RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
span
  )
-- TODO: the bad locations are all (-1) right now
-- is this fine? it should be, since noLoc from HSE previously also used (-1) as an invalid location
toOldeSpan (UnhelpfulSpan UnhelpfulSpanReason
_) =
  ( FilePath
"no-span"
  , -Int
1
  , -Int
1
  , -Int
1
  , -Int
1
  )

{-# COMPLETE SrcLoc #-}
pattern SrcLoc :: String -> Int -> Int -> SrcLoc
pattern $mSrcLoc :: forall r.
SrcLoc -> (FilePath -> Int -> Int -> r) -> (Void# -> r) -> r
SrcLoc
  { SrcLoc -> FilePath
srcFilename
  , SrcLoc -> Int
srcLine
  , SrcLoc -> Int
srcColumn
  }
  <-
    (toOldeLoc ->
      ( srcFilename
      , srcLine
      , srcColumn
      ))

toOldeLoc :: SrcLoc -> (String, Int, Int)
toOldeLoc :: SrcLoc -> (FilePath, Int, Int)
toOldeLoc (RealSrcLoc RealSrcLoc
loc Maybe BufPos
_) =
  ( FastString -> FilePath
unpackFS (FastString -> FilePath) -> FastString -> FilePath
forall a b. (a -> b) -> a -> b
$ RealSrcLoc -> FastString
srcLocFile RealSrcLoc
loc
  , RealSrcLoc -> Int
srcLocLine RealSrcLoc
loc
  , RealSrcLoc -> Int
srcLocCol RealSrcLoc
loc
  )
toOldeLoc (UnhelpfulLoc FastString
_) =
  ( FilePath
"no-loc"
  , -Int
1
  , -Int
1
  )

showSrcSpan :: SrcSpan -> String
showSrcSpan :: SrcSpan -> FilePath
showSrcSpan = SrcSpan -> FilePath
forall a. Outputable a => a -> FilePath
unsafePrettyPrint