-- -- Copyright (c) 2013 Bonelli Nicola -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- module CGrep.Output (Output(..), mkOutput, putPrettyHeader, putPrettyFooter, prettyOutput, showFile) where import qualified Data.ByteString.Char8 as C import System.Console.ANSI #ifdef ENABLE_HINT import Language.Haskell.Interpreter #endif import Data.Maybe import Data.List import Data.List.Split import Data.Function import CGrep.Types import CGrep.Token import Safe import Options data Output = Output FilePath Int Text8 [Token] deriving (Show) getOffsetsLines :: Text8 -> [Int] getOffsetsLines = C.elemIndices '\n' getOffset2d :: [OffsetLine] -> Offset -> Offset2d getOffset2d idx off = let prc = fst $ partition (< off) idx in case prc of [] -> (0, off) _ -> (length prc, off - last prc - 1) mkOutput :: Options -> FilePath -> Text8 -> Text8 -> [Token] -> [Output] mkOutput Options { invert_match = invert } f text multi ts | invert = map (\(n, xs) -> Output f n (ls !! (n-1)) xs) . invertMatchLines (length ls) $ mkMatchLines multi ts | otherwise = map (\(n, xs) -> Output f n (ls !! (n-1)) xs) $ mkMatchLines multi ts where ls = C.lines text mkMatchLines :: Text8 -> [Token] -> [MatchLine] mkMatchLines _ [] = [] mkMatchLines text ts = map mergeGroup $ groupBy ((==) `on` fst) $ sortBy (compare `on` fst) $ map (\t -> let (r,c) = getOffset2d ols (fst t) in (1 + r, [(c, snd t)])) ts where mergeGroup ls = (fst $ head ls, foldl (\l m -> l ++ snd m) [] ls) ols = getOffsetsLines text invertMatchLines :: Int -> [MatchLine] -> [MatchLine] invertMatchLines n xs = filter (\(i,_) -> i `notElem` idx ) $ take n [ (i, []) | i <- [1..]] where idx = map fst xs putPrettyHeader :: Options -> IO () putPrettyHeader opt = case () of _ | json opt -> putStrLn "[" | xml opt -> putStrLn "" >> putStrLn "" | otherwise -> return () putPrettyFooter :: Options -> IO () putPrettyFooter opt = case () of _ | json opt -> putStrLn "]" | xml opt -> putStrLn "" | otherwise -> return () prettyOutput :: Options -> [Output] -> IO [String] prettyOutput opt out #ifdef ENABLE_HINT | isJust $ hint opt = hintOputput opt out #endif | isJust $ format opt = return $ map (formatOutput opt) out | json opt = return $ jsonOutput opt out | xml opt = return $ xmlOutput opt out | otherwise = return $ map (defaultOutput opt) out defaultOutput :: Options -> Output -> String defaultOutput opt@ Options { no_filename = False, no_linenumber = False , count = False } (Output f n l ts) = showFile opt f ++ ":" ++ show n ++ ":" ++ showTokens opt ts ++ showLine opt ts l defaultOutput opt@ Options { no_filename = False, no_linenumber = True , count = False } (Output f _ l ts) = showFile opt f ++ ":" ++ showTokens opt ts ++ showLine opt ts l defaultOutput opt@ Options { no_filename = True , no_linenumber = False , count = False } (Output _ n l ts) = show n ++ ":" ++ showTokens opt ts ++ showLine opt ts l defaultOutput opt@ Options { no_filename = True , no_linenumber = True , count = False } (Output _ _ l ts) = showTokens opt ts ++ showLine opt ts l defaultOutput opt@ Options { count = True } (Output f n _ _) = showFile opt f ++ ":" ++ show n jsonOutput :: Options -> [Output] -> [String] jsonOutput _ outs = [" { \"file\": " ++ show fname ++ ", \"matches\": ["] ++ [ intercalate "," (foldl mkMatch [] outs) ] ++ ["] }"] where fname | (Output f _ _ _) <- head outs = f mkToken (n, xs) = "{ \"col\": " ++ show n ++ ", \"token\": " ++ show xs ++ " }" mkMatch xs (Output _ n l ts) = xs ++ [ "{ \"row\": " ++ show n ++ ", \"tokens\": [" ++ intercalate "," (map mkToken ts) ++ "], \"line\":" ++ show l ++ "}" ] xmlOutput :: Options -> [Output] -> [String] xmlOutput _ outs = ["" ] ++ ["" ] ++ [foldl mkMatch "" outs] ++ [""] ++ [""] where fname | (Output f _ _ _) <- head outs = f mkToken (n, xs) = "" ++ xs ++ "" mkMatch xs (Output _ n l ts) = xs ++ "" ++ unwords (map mkToken ts) ++ "" formatOutput :: Options -> Output -> String formatOutput opt (Output f n l ts) = foldl trans (fromJust $ format opt) [ ("#f", showFile opt f), ("#n", show n), ("#l", showLine opt ts l), ("#t", show ts'), ("##", unwords ts'), ("#,", intercalate "," ts'), ("#;", intercalate ";" ts'), ("#0", atDef "" ts' 0), ("#1", atDef "" ts' 1), ("#2", atDef "" ts' 2), ("#3", atDef "" ts' 3), ("#4", atDef "" ts' 4), ("#5", atDef "" ts' 5), ("#6", atDef "" ts' 6), ("#7", atDef "" ts' 7), ("#8", atDef "" ts' 8), ("#9", atDef "" ts' 9) ] where trans str (old, new) = replace old new str ts' = map snd ts replace :: Eq a => [a] -> [a] -> [a] -> [a] replace old new = intercalate new . splitOn old #ifdef ENABLE_HINT hintOputput :: Options -> [Output] -> IO [String] hintOputput opt outs = do let cmds = map mkCmd outs out <- runInterpreter $ setImports ["Prelude", "Data.List"] >> mapM (`interpret` (as :: String)) cmds return $ either ((:[]) . show) id out where mkCmd (Output f n l ts) = "let a # b = a !! b " ++ "; file = " ++ show (showFile opt f) ++ "; row = " ++ show n ++ "; line = " ++ show (showLine opt ts l) ++ "; tokens = " ++ show (map snd ts) ++ " in " ++ (fromJust $ hint opt) #endif blue, bold, resetTerm :: String blue = setSGRCode [SetColor Foreground Vivid Blue] bold = setSGRCode [SetConsoleIntensity BoldIntensity] resetTerm = setSGRCode [] showTokens :: Options -> [Token] -> String showTokens Options { show_match = st } xs | st = show (map snd xs) | otherwise = "" showFile :: Options -> String -> String showFile Options { color = c } f | c = bold ++ blue ++ f ++ resetTerm | otherwise = f showLine :: Options -> [Token] -> Line8 -> String showLine Options { color = c } ts l | c = hilightLine (sortBy (flip compare `on` (length . snd )) ts) (C.unpack l) | otherwise = C.unpack l hilightLine :: [Token] -> String -> String hilightLine ts = hilightLine' (hilightIndicies ts, 0) where hilightLine' :: ([Int],Int) -> String -> String hilightLine' _ [] = [] hilightLine' (ns,n) (x:xs) = (if n `elem` ns then bold ++ [x] ++ resetTerm else [x]) ++ hilightLine' (ns, n+1) xs hilightIndicies :: [Token] -> [Int] hilightIndicies = concatMap (\(o, s) -> take (length s) [o..])