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