Commit c23435f0 authored by Andrew Gibiansky's avatar Andrew Gibiansky

Special-casing some error messages line wrapping, closes #76

parent 552cb20a
No preview for this file type
/* /*
Custom IHaskell CSS. Custom IHaskell CSS.
*/ */
/* Styles used for basic displays */
.get-type {
color: green;
font-weight: bold;
font-family: monospace;
}
.err-msg {
color: red;
font-style: italic;
font-family: monospace;
white-space: pre;
}
/* Code that will get highlighted before it is highlighted */
.highlight-code { .highlight-code {
white-space: pre; white-space: pre;
font-family: monospace; font-family: monospace;
} }
/* Hlint styles */
.suggestion-warning { .suggestion-warning {
font-weight: bold; font-weight: bold;
color: rgb(200, 130, 0); color: rgb(200, 130, 0);
......
...@@ -12,7 +12,7 @@ import ClassyPrelude hiding (liftIO, hGetContents, try) ...@@ -12,7 +12,7 @@ import ClassyPrelude hiding (liftIO, hGetContents, try)
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Prelude (putChar, head, tail, last, init, (!!)) import Prelude (putChar, head, tail, last, init, (!!))
import Data.List.Utils import Data.List.Utils
import Data.List(findIndex) import Data.List(findIndex, and)
import Data.String.Utils import Data.String.Utils
import Text.Printf import Text.Printf
import Data.Char as Char import Data.Char as Char
...@@ -719,20 +719,44 @@ capturedStatement output stmt = do ...@@ -719,20 +719,44 @@ capturedStatement output stmt = do
return (printedOutput, result) return (printedOutput, result)
formatError :: ErrMsg -> String formatError :: ErrMsg -> String
formatError = printf "<span style='color: red; font-style: italic;'>%s</span>" . formatError = printf "<span class='err-msg'>%s</span>" .
replace "\n" "<br/>" . replace "\n" "<br/>" .
fixLineWrapping .
replace useDashV "" . replace useDashV "" .
rstrip . rstrip .
typeCleaner typeCleaner
where where
useDashV = "\nUse -v to see a list of the files searched for." useDashV = "\nUse -v to see a list of the files searched for."
fixLineWrapping err
| isThreePartTypeError err =
let (before, exp:after) = break ("Expected type" `isInfixOf`) $ lines err
(expected, act:actual) = break ("Actual type" `isInfixOf`) after in
unlines $ map unstripped [before, exp:expected, act:actual]
| isTwoPartTypeError err =
let (one, two) = break ("with actual type" `isInfixOf`) $ lines err in
unlines $ map unstripped [one, two]
| otherwise = err
where
unstripped (line:lines) = unwords $ line:map lstrip lines
isThreePartTypeError err = all (`isInfixOf` err) [
"Couldn't match type",
"with",
"Expected type:",
"Actual type:"
]
isTwoPartTypeError err = all (`isInfixOf` err) [
"Couldn't match expected type",
"with actual type"
]
formatParseError :: StringLoc -> String -> ErrMsg formatParseError :: StringLoc -> String -> ErrMsg
formatParseError (Loc line col) = formatParseError (Loc line col) =
printf "Parse error (line %d, column %d): %s" line col printf "Parse error (line %d, column %d): %s" line col
formatGetType :: String -> String formatGetType :: String -> String
formatGetType = printf "<span style='font-weight: bold; color: green;'>%s</span>" formatGetType = printf "<span class='get-type'>%s</span>"
displayError :: ErrMsg -> [DisplayData] displayError :: ErrMsg -> [DisplayData]
displayError msg = [plain . typeCleaner $ msg, html $ formatError msg] displayError msg = [plain . typeCleaner $ msg, html $ formatError msg]
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment