abc6b5c · Idris-dev · git.iko.soy

50 renderPretty 1.0 80 .

51 fmap (fancifyAnnots ist True) $ pprintErr ist err

52

53−formatWarning :: FC -> String -> Maybe String

54−formatWarning (FC fn (si, sj) (ei, ej)) src =

55− if isJust sourceLine

56− then Just (top ++ "\n" ++ formattedLine ++ "\n" ++ bottom)

57− else Nothing

58− where

59− sourceLine = listToMaybe . drop (si - 1) . lines $ src

60− formattedLine = show si ++ " | " ++ fromJust sourceLine

61− top = take (length (show si)) (repeat ' ') ++ " |"

62− indicator = case (si == ei, sj == ej) of

63− (True , True ) -> "^"

64− (True , False) -> squiggles (ej - sj + 1)

65− (False, _ ) -> squiggles (length (fromJust sourceLine) - sj + 1) ++ " ..."

66− bottom = top ++ " " ++ (take (sj - 1) (repeat ' ')) ++ indicator

67− squiggles n = take n (repeat '~')

68−formatWarning _ _ = Nothing

69−

70−readSource :: FC -> Idris (Maybe String)

71−readSource (FC fn _ _) = do

72− result <- runIO $ tryIOError (readFile fn)

73− case result of

74− Left _ -> pure Nothing

75− Right v -> pure (Just v)

76−readSource _ = pure Nothing

77−

78−

79−iWarn :: FC -> Doc OutputAnnotation -> Idris ()

53+type OutputDoc = Doc OutputAnnotation

54+

55+iWarn :: FC -> OutputDoc -> Idris ()

80iWarn fc err =

56iWarn fc err =

81 do i <- getIState

57 do i <- getIState

82 case idris_outputmode i of

58 case idris_outputmode i of

83 RawOutput h ->

59 RawOutput h ->

84 do maybeSource <- readSource fc

60 do maybeSource <- readSource fc

85− let maybeFormattedSource = (maybeSource >>= formatWarning fc)

61+ let maybeFormattedSource = (maybeSource >>= layoutSource fc)

86 err' <- iRender . fmap (fancifyAnnots i True) $

62 err' <- iRender . fmap (fancifyAnnots i True) $

87− layoutError (formatFC fc) (fmap string maybeFormattedSource) err

63+ layoutWarning (layoutFC fc) (fmap string maybeFormattedSource) err

88 hWriteDoc h i err'

64 hWriteDoc h i err'

89 IdeMode n h ->

65 IdeMode n h ->

90 do err' <- iRender . fmap (fancifyAnnots i True) $ err

66 do err' <- iRender . fmap (fancifyAnnots i True) $ err

92 runIO . hPutStrLn h $

68 runIO . hPutStrLn h $

93 convSExp "warning" (fc_fname fc, fc_start fc, fc_end fc, str, spans) n

69 convSExp "warning" (fc_fname fc, fc_start fc, fc_end fc, str, spans) n

94 where

70 where

95− formatFC :: FC -> Doc OutputAnnotation

71+ layoutFC :: FC -> OutputDoc

96− formatFC (FC fn _ _) | fn /= "" = text (show fc) <> colon

72+ layoutFC (FC fn _ _) | fn /= "" = text (show fc) <> colon

97− formatFC _ = empty

73+ layoutFC _ = empty

98−

74+

99− layoutError :: Doc OutputAnnotation -> Maybe (Doc OutputAnnotation) -> Doc OutputAnnotation -> Doc OutputAnnotation

75+ readSource :: FC -> Idris (Maybe String)

76+ readSource (FC fn _ _) = do

77+ result <- runIO $ tryIOError (readFile fn)

78+ case result of

79+ Left _ -> pure Nothing

80+ Right v -> pure (Just v)

81+ readSource _ = pure Nothing

82+

83+ layoutSource :: FC -> String -> Maybe String

84+ layoutSource (FC fn (si, sj) (ei, ej)) src =

85+ if isJust sourceLine

86+ then Just (top ++ "\n" ++ formattedLine ++ "\n" ++ bottom)

87+ else Nothing

88+ where

89+ sourceLine = listToMaybe . drop (si - 1) . lines $ src

90+ formattedLine = show si ++ " | " ++ fromJust sourceLine

91+ top = take (length (show si)) (repeat ' ') ++ " |"

92+ indicator = case (si == ei, sj == ej) of

93+ (True , True ) -> "^"

94+ (True , False) -> squiggles (ej - sj + 1)

95+ (False, _ ) -> squiggles (length (fromJust sourceLine) - sj + 1) ++ " ..."

96+ bottom = top ++ " " ++ (take (sj - 1) (repeat ' ')) ++ indicator

97+ squiggles n = take n (repeat '~')

98+ layoutSource _ _ = Nothing

99+

100+ layoutWarning :: OutputDoc -> Maybe OutputDoc -> OutputDoc -> OutputDoc

100− layoutError loc (Just src) err = loc <$$> src <$$> err

101+ layoutWarning loc (Just src) err = loc <$$> src <$$> err

101− layoutError loc Nothing err = loc </> err

102+ layoutWarning loc Nothing err = loc </> err

102

103

104

104iRender :: Doc a -> Idris (SimpleDoc a)

105iRender :: Doc a -> Idris (SimpleDoc a)