module Language.Haskell.HBB.Inline (
inline,
inlineM,
showInlineResult,
BufLoc(..),
BufSpan(..),
NonFirstLinesIndenting(..),
InlineOptions(..),
defaultInlineOptions
) where
import Language.Haskell.HBB.Internal.InternalTTreeCreation
import Language.Haskell.HBB.Internal.InterfaceTypes
import Language.Haskell.HBB.Internal.InternalTTree
import Language.Haskell.HBB.Internal.GHCHighlevel
import Language.Haskell.HBB.Internal.TTreeColor
import Language.Haskell.HBB.Internal.SrcSpan
import Language.Haskell.HBB.Internal.TTree
import Language.Haskell.HBB.Internal.GHC
import Control.Monad.Reader hiding (liftIO)
import FastString (unpackFS)
import GHC.Paths (libdir)
import GhcMonad (liftIO,GhcMonad)
import SrcLoc
data InlineOptions = InlineOptions { showContext :: Bool
, showAnsiColored :: Bool
, adaptToTargetEnv :: NonFirstLinesIndenting }
defaultInlineOptions :: InlineOptions
defaultInlineOptions = InlineOptions { showContext = False
, showAnsiColored = False
, adaptToTargetEnv = IgnoreIndOfTargetEnv }
inline :: [String] -> InlineOptions -> FilePath -> BufLoc -> Maybe BufLoc -> IO (BufSpan,String)
inline ghcOptions iopts fn sl mbEndLoc =
runGhcWithCmdLineFlags ghcOptions (Just libdir) $ inlineM iopts fn sl mbEndLoc
showInlineResult :: (BufSpan,String) -> String
showInlineResult = snd
inlineM :: GhcMonad m => InlineOptions -> FilePath -> BufLoc -> Maybe BufLoc -> m (BufSpan,String)
inlineM (InlineOptions { showContext = sc , showAnsiColored = sa , adaptToTargetEnv = ai })
occFileName
startLoc
mbEndLoc = do
sti@(SearchedTokenInfo { result = (bindInfo,_) }) <- searchFunctionBindingM occFileName startLoc mbEndLoc
occFileContent <- liftIO $ readFile occFileName
(bindFileName,bindFileContent) <- do
let (L (RealSrcSpan r) _) = bindInfo
n = unpackFS $ srcSpanFile r
content <- liftIO $ readFile n
return (n,content)
let tree@(TTree c childs) =
let produceClientTTree :: FunBindInfo -> ClientTTree
produceClientTTree sti'@(SearchedTokenInfo { result = (bi,_) }) =
let richTTree = runReader (toTTree bi) ProduceLambda
inlCol = ((srcLocCol $ realSrcSpanStart $ occSpan sti'))
insSpan = pointBufSpan 1 (case ai of AdaptIndToTargetEnv -> inlCol
IgnoreIndOfTargetEnv -> 1)
in snd $ applyIndentation (IncInline insSpan,richTTree)
in produceClientTTree sti
fileCache = if occFileName == bindFileName
then [( occFileName,str2LineBuf occFileContent)]
else [( occFileName,str2LineBuf occFileContent)
,(bindFileName,str2LineBuf bindFileContent)]
let alteredContent = case sc of
True ->
let spn = toBufSpan $ occSpan sti
in case sa of
True -> applyColoredTTree fileCache (spn,tree) (str2LineBuf occFileContent)
False -> applyTTree fileCache (spn,tree) (str2LineBuf occFileContent)
False ->
let spn = pointBufSpan 1 1
in case sa of
True -> applyColoredTTree fileCache (spn,(TTree c childs)) [""]
False -> applyTTree fileCache (spn,(TTree c childs)) [""]
return (toBufSpan $ occSpan sti,lineBuf2Str alteredContent)