@@ -50,41 +50,17 @@ pshow ist err = displayDecorated (consoleDecorate ist) .
5050 renderPretty 1.0 80 .
5151 fmap (fancifyAnnots ist True) $ pprintErr ist err
5252
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 ()
8056iWarn fc err =
8157 do i <- getIState
8258 case idris_outputmode i of
8359 RawOutput h ->
8460 do maybeSource <- readSource fc
85− let maybeFormattedSource = (maybeSource >>= formatWarning fc)
61+ let maybeFormattedSource = (maybeSource >>= layoutSource fc)
8662 err' <- iRender . fmap (fancifyAnnots i True) $
87− layoutError (formatFC fc) (fmap string maybeFormattedSource) err
63+ layoutWarning (layoutFC fc) (fmap string maybeFormattedSource) err
8864 hWriteDoc h i err'
8965 IdeMode n h ->
9066 do err' <- iRender . fmap (fancifyAnnots i True) $ err
@@ -92,13 +68,38 @@ iWarn fc err =
9268 runIO . hPutStrLn h $
9369 convSExp "warning" (fc_fname fc, fc_start fc, fc_end fc, str, spans) n
9470 where
95− formatFC :: FC -> Doc OutputAnnotation
96− formatFC (FC fn _ _) | fn /= "" = text (show fc) <> colon
97− formatFC _ = empty
98−
99− layoutError :: Doc OutputAnnotation -> Maybe (Doc OutputAnnotation) -> Doc OutputAnnotation -> Doc OutputAnnotation
100− layoutError loc (Just src) err = loc <$$> src <$$> err
101− layoutError loc Nothing err = loc </> err
71+ layoutFC :: FC -> OutputDoc
72+ layoutFC (FC fn _ _) | fn /= "" = text (show fc) <> colon
73+ layoutFC _ = empty
74+
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
101+ layoutWarning loc (Just src) err = loc <$$> src <$$> err
102+ layoutWarning loc Nothing err = loc </> err
102103
103104
104105iRender :: Doc a -> Idris (SimpleDoc a)