1-- Copyright (c) Facebook, Inc. and its affiliates. 2-- 3-- This source code is licensed under the MIT license found in the 4-- LICENSE file in the root directory of this source tree. 5-- 6module Retrie.Pretty 7 ( noColor 8 , addColor 9 , ppSrcSpan 10 , ColoriseFun 11 , strip 12 , ppRepl 13 , linesMap 14 ) where 15 16import Data.Char 17import Data.List 18import Data.Maybe 19import qualified Data.HashMap.Strict as HashMap 20import System.Console.ANSI 21 22import Retrie.GHC 23 24type ColoriseFun = ColorIntensity -> Color -> String -> String 25 26noColor :: ColoriseFun 27noColor _ _ = id 28 29addColor :: ColoriseFun 30addColor intensity color x = mconcat 31 [ setSGRCode [SetColor Foreground intensity color] 32 , x 33 , setSGRCode [Reset] 34 ] 35 36-- | Pretty print location of the file. 37ppSrcSpan :: ColoriseFun -> SrcSpan -> String 38ppSrcSpan colorise spn = case srcSpanStart spn of 39 UnhelpfulLoc x -> unpackFS x 40 RealSrcLoc loc -> intercalate (colorise Dull Cyan ":") 41 [ colorise Dull Magenta $ unpackFS $ srcLocFile loc 42 , colorise Dull Green $ show $ srcLocLine loc 43 , colorise Dull Green $ show $ srcLocCol loc 44 , "" 45 ] 46 47-- | Get lines covering span and replace span with replacement string. 48ppRepl :: HashMap.HashMap Int String -> SrcSpan -> String -> [String] 49ppRepl lMap spn replacement = fromMaybe [replacement] $ do 50 startPos <- getRealLoc $ srcSpanStart spn 51 endPos <- getRealLoc $ srcSpanEnd spn 52 startLine <- getLine' startPos 53 endLine <- getLine' endPos 54 return $ lines $ mconcat 55 [ take (srcLocCol startPos - 1) startLine 56 , dropWhile isSpace replacement 57 , drop (srcLocCol endPos - 1) endLine 58 ] 59 where 60 getLine' pos = HashMap.lookup (srcLocLine pos) lMap 61 62-- | Return HashMap from line number to line of a file. 63linesMap :: String -> IO (HashMap.HashMap Int String) 64linesMap fp = HashMap.fromList . zip [1..] . lines <$> readFile fp 65 66getRealLoc :: SrcLoc -> Maybe RealSrcLoc 67getRealLoc (RealSrcLoc x) = Just x 68getRealLoc _ = Nothing 69 70strip :: String -> String 71strip = dropWhileEnd isSpace . dropWhile isSpace 72