ApplyTTree.hs


module Language.Haskell.HBB.TestModes.ApplyTTree (
    ApplyTTreeArgs(..),
    defaultApplyTTreeArgs,
    testModeApplyTTree
    ) where

import           Language.Haskell.HBB.Internal.TTreeColor
import           Language.Haskell.HBB.Internal.TTreeJSON
import           Language.Haskell.HBB.Internal.SrcSpan
import           Language.Haskell.HBB.Internal.TTree
import qualified Data.ByteString.Char8 as StrictByteString
import           System.Environment (getArgs)
import           Data.Generics
import           FastString (unpackFS,mkFastString)
import           Data.List (sortBy,union)
import           SrcLoc

-- | This type is used to have influence on the processing of
-- testModeApplyTTree. It is possible to activate ANSI color escape sequences
-- for the text or to enable the printing of the file context.
data ApplyTTreeArgs = ApplyTTreeArgs { applyToShowContext     :: Bool
                                     , applyToShowAnsiColored :: Bool }

-- | These are the default options used for this mode.
-- libhbb-cli only uses these default settings.
defaultApplyTTreeArgs :: ApplyTTreeArgs
defaultApplyTTreeArgs = ApplyTTreeArgs { applyToShowContext = False , applyToShowAnsiColored = False }


-- | This function reads a transformation-tree serialized to JSON from standard
-- input and applies it which means that it converts it to text. After having
-- it applied the text is returned as one single string.
testModeApplyTTree :: ApplyTTreeArgs -> IO String
testModeApplyTTree options = do
    jsonString <- StrictByteString.getContents
    case decodeTTreeFromJSON jsonString of
        Left  msg  -> fail $ "Failure reading TTree from stdin: " ++ msg
        Right tree -> applyTTree' options tree
 
-- | This is a helper function for testModeApplyTTree which does most of the
-- work.
applyTTree' :: ApplyTTreeArgs -> (RealSrcSpan,ClientTTree) -> IO String
applyTTree' 
    (ApplyTTreeArgs { applyToShowContext = sc , applyToShowAnsiColored = sa })
    (spn,tree) = do 
        let occFile = unpackFS  $ srcSpanFile spn
        occFileContent <- readFile occFile
        let affectedNames = [occFile] `union` collectFilenames (toBufSpan spn,tree)
        fileCache <- cacheFiles affectedNames
        let alteredContent = case sc of
                True  -> 
                    let lns = lines occFileContent
                    in case sa of
                        True  -> applyColoredTTree fileCache (toBufSpan spn,tree) lns
                        False -> applyTTree        fileCache (toBufSpan spn,tree) lns
                False -> case sa of
                        True  -> applyColoredTTree fileCache (pointBufSpan 1 1,tree) [""]
                        False -> applyTTree        fileCache (pointBufSpan 1 1,tree) [""]
        return $ unlines alteredContent