SmartInline.hs

{-# OPTIONS -Wall #-}

module Language.Haskell.HBB.SmartInline (
    smartinline,
    smartinlineM,
    showSmartInlineResult,
    showSmartInlineResultAsByteString,
    NonFirstLinesIndenting(..),
    BufLoc(..),
    BufSpan(..),
    RealSrcSpan(..),
    TTree(..),
    LineBuf,
    encodeTTreeToJSON,
    decodeTTreeFromJSON
    ) 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.TTreeJSON (encodeTTreeToJSON,decodeTTreeFromJSON)
import           Language.Haskell.HBB.Internal.SrcSpan
import           Language.Haskell.HBB.Internal.TTree
import           Language.Haskell.HBB.Internal.GHC
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.ByteString.Char8      as B
import           Control.Monad.Reader
import           GHC.Paths (libdir)
import           SrcLoc
import           GHC (GhcMonad)


-- | This function implements the mode 'smart-inline'.
--
-- Smart-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 is described as transformation to the original source code. The
-- transformation is a JSON string which is formatted according to the
-- descriptions in the documentation.
--
-- > main :: IO ()
-- > main = do
-- >     res <- smartinline ["-isrc"] IgnoreIndOfTargetEnv "example/Example.hs" (BufLoc 14 13)
-- >     LazyByteString.putStr $ encodeTTreeToJSON res
-- >     putStrLn ""
--
-- 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
-- smart-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 two 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
--
smartinline :: [String] -> NonFirstLinesIndenting -> FilePath -> BufLoc -> Maybe BufLoc 
    -> IO (RealSrcSpan,TTree LineBuf (RealSrcSpan,Int) BufSpan)
smartinline ghcOptions ai fn sl mbEndLoc = 
    runGhcWithCmdLineFlags ghcOptions (Just libdir) $ smartinlineM ai fn sl mbEndLoc

-- | Converts the result of smartinline and smartinlineM to JSON.
--
-- The resulting string has exactly the format that should be understood by
-- text editors that are using mode smart-inline.
showSmartInlineResult :: (RealSrcSpan,TTree LineBuf (RealSrcSpan,Int) BufSpan) -> String
showSmartInlineResult spanAndTree =
    B.unpack $ B.concat $ BL.toChunks $ showSmartInlineResultAsByteString spanAndTree

-- | This function is a performance optimization to showSmartInlineResult as
-- the resulting bytestring isn't converted back to string.
showSmartInlineResultAsByteString :: (RealSrcSpan,TTree LineBuf (RealSrcSpan,Int) BufSpan) -> BL.ByteString
showSmartInlineResultAsByteString spanAndTree =
    BL.snoc (encodeTTreeToJSON spanAndTree) '\n'

-- | This function is similar to smartinline except that it runs in a GhcMonad
-- instance.
smartinlineM :: GhcMonad m => NonFirstLinesIndenting -> FilePath -> BufLoc -> Maybe BufLoc 
    -> m (RealSrcSpan,TTree LineBuf (RealSrcSpan,Int) BufSpan)
smartinlineM ai filename startLoc mbEndLoc = do

    sti@(SearchedTokenInfo { result = (binding,_) }) <- searchFunctionBindingM filename startLoc mbEndLoc

    let produceClientTTree :: FunBindInfo -> ClientTTree
        produceClientTTree bi =
            let richTTree = runReader (toTTree $ binding) ProduceLambda
                inlCol    = ((srcLocCol $ realSrcSpanStart $ occSpan bi))
                insSpan   = pointBufSpan 1 (case ai of AdaptIndToTargetEnv  -> inlCol 
                                                       IgnoreIndOfTargetEnv -> 1)
            in  snd $ applyIndentation (IncInline insSpan,richTTree)

    return (occSpan sti,produceClientTTree sti)