Inline.hs

{-# OPTIONS -Wall #-}

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

-- | The data type InlineOptions is to alter the behviour of the function
-- 'inline'.
--
-- If 'showContext' is true 'inline' not only prints the inlined version of the
-- function or value binding but also the file context.
--
-- If 'showAnsiColored' is true 'inline' will use ANSI terminal colors to
-- highlight different logical informations in the inlined version. Colors are
-- used for areas that are identical with the original function or value
-- binding (displays) and a bold grey is used for areas that have been added
-- and do not occur in the original binding (additions).
data InlineOptions = InlineOptions { showContext      :: Bool
                                   , showAnsiColored  :: Bool 
                                   , adaptToTargetEnv :: NonFirstLinesIndenting }

-- | This value defines the default options for inlining.
--
-- Most text editors will need these settings (maybe adaptToTargetEnv should be
-- adapted). The inlined version of the function or value binding is printed
-- without ANSI colors and without context but with non-first lines being
-- indented to a level that allows a text editor to replace the original name
-- with the return value of mode 'inline'.
defaultInlineOptions :: InlineOptions
defaultInlineOptions = InlineOptions { showContext      = False 
                                     , showAnsiColored  = False 
                                     , adaptToTargetEnv = IgnoreIndOfTargetEnv }

-- | This function implements the mode 'inline'.
--
-- Inline takes a location or a span within a file which should be a function
-- binding (as of 2014-09-16 excluding any parameter) and tries to produce an
-- inlined version of the function. The inlined version of the function then is
-- written to standard output.
--
-- @
-- main :: IO ()
-- main = inline [\"-iexample\"] defaultInlineOptions \"example/Example.hs\" (BufLoc 14 13)
-- @
--
-- It is important to know that the indentation of non-first lines (as of
-- 2014-09-16) is always adapted to match the indentation of the location where
-- the name should be replaced.
-- If a second location isn't passed this function will use GHCs lexer to find
-- out where the end of the variable or function name is. Consequently to
-- inline a function and to simultaneously apply it to its arguments (which is
-- not supported as of 2014-09-16) the second location must be passed.
--
-- The first three command line parameters are:
--
--  - The GHC options as string list (as they should appear on the command line)
--
--  - Some options to the mode 'inline' that change the functions behaviour
--
--  - The path to the GHC library folder (the module GHC.Paths exports 'libdir'
--    which can be used here)
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

-- | This function creates a string of the result returned by inline or
-- inlineM.
--
-- The string has exactly the format that should be understood by text editors
-- that are using the mode inline.
showInlineResult :: (BufSpan,String) -> String
showInlineResult = snd

-- | This is the monadic version of inline.
--
-- Instead of taking command line flags to alter the GHC environment this
-- function can be used with a custom GhcMonad instance which allows more
-- control about GHCs behaviour.
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)