module Language.Futhark.Warnings
( Warnings
, singleWarning
) where
import Data.Monoid
import Data.List (sortOn, intercalate)
import Data.Loc
import Prelude
import Language.Futhark.Core (locStr)
newtype Warnings = Warnings [(SrcLoc, String)] deriving (Warnings -> Warnings -> Bool
(Warnings -> Warnings -> Bool)
-> (Warnings -> Warnings -> Bool) -> Eq Warnings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Warnings -> Warnings -> Bool
$c/= :: Warnings -> Warnings -> Bool
== :: Warnings -> Warnings -> Bool
$c== :: Warnings -> Warnings -> Bool
Eq)
instance Semigroup Warnings where
Warnings [(SrcLoc, String)]
ws1 <> :: Warnings -> Warnings -> Warnings
<> Warnings [(SrcLoc, String)]
ws2 = [(SrcLoc, String)] -> Warnings
Warnings ([(SrcLoc, String)] -> Warnings) -> [(SrcLoc, String)] -> Warnings
forall a b. (a -> b) -> a -> b
$ [(SrcLoc, String)]
ws1 [(SrcLoc, String)] -> [(SrcLoc, String)] -> [(SrcLoc, String)]
forall a. Semigroup a => a -> a -> a
<> [(SrcLoc, String)]
ws2
instance Monoid Warnings where
mempty :: Warnings
mempty = [(SrcLoc, String)] -> Warnings
Warnings [(SrcLoc, String)]
forall a. Monoid a => a
mempty
instance Show Warnings where
show :: Warnings -> String
show (Warnings []) = String
""
show (Warnings [(SrcLoc, String)]
ws) =
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n\n" [String]
ws' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
where ws' :: [String]
ws' = ((SrcLoc, String) -> String) -> [(SrcLoc, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (SrcLoc, String) -> String
forall a. Located a => (a, String) -> String
showWarning ([(SrcLoc, String)] -> [String]) -> [(SrcLoc, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((SrcLoc, String) -> Int)
-> [(SrcLoc, String)] -> [(SrcLoc, String)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Loc -> Int
off (Loc -> Int)
-> ((SrcLoc, String) -> Loc) -> (SrcLoc, String) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf (SrcLoc -> Loc)
-> ((SrcLoc, String) -> SrcLoc) -> (SrcLoc, String) -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcLoc, String) -> SrcLoc
forall a b. (a, b) -> a
fst) [(SrcLoc, String)]
ws
off :: Loc -> Int
off Loc
NoLoc = Int
0
off (Loc Pos
p Pos
_) = Pos -> Int
posCoff Pos
p
showWarning :: (a, String) -> String
showWarning (a
loc, String
w) =
String
"Warning at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Located a => a -> String
locStr a
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" "String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
w)
singleWarning :: SrcLoc -> String -> Warnings
singleWarning :: SrcLoc -> String -> Warnings
singleWarning SrcLoc
loc String
problem = [(SrcLoc, String)] -> Warnings
Warnings [(SrcLoc
loc, String
problem)]