{-# LANGUAGE Safe #-} -- | A very simple representation of collections of warnings. -- Warnings have a position (so they can be ordered), and their -- 'Show'-instance produces a human-readable string. module Language.Futhark.Warnings ( Warnings , singleWarning , singleWarning' ) where import Data.Monoid import Data.List (sortOn, intercalate) import Prelude import Language.Futhark.Core (locStr, prettyStacktrace) import Futhark.Util.Console (inRed) import Futhark.Util.Loc -- | The warnings produced by the compiler. The 'Show' instance -- produces a human-readable description. newtype Warnings = Warnings [(SrcLoc, [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, [SrcLoc], String)] ws1 <> :: Warnings -> Warnings -> Warnings <> Warnings [(SrcLoc, [SrcLoc], String)] ws2 = [(SrcLoc, [SrcLoc], String)] -> Warnings Warnings ([(SrcLoc, [SrcLoc], String)] -> Warnings) -> [(SrcLoc, [SrcLoc], String)] -> Warnings forall a b. (a -> b) -> a -> b $ [(SrcLoc, [SrcLoc], String)] ws1 [(SrcLoc, [SrcLoc], String)] -> [(SrcLoc, [SrcLoc], String)] -> [(SrcLoc, [SrcLoc], String)] forall a. Semigroup a => a -> a -> a <> [(SrcLoc, [SrcLoc], String)] ws2 instance Monoid Warnings where mempty :: Warnings mempty = [(SrcLoc, [SrcLoc], String)] -> Warnings Warnings [(SrcLoc, [SrcLoc], String)] forall a. Monoid a => a mempty instance Show Warnings where show :: Warnings -> String show (Warnings []) = String "" show (Warnings [(SrcLoc, [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, [SrcLoc], String) -> String) -> [(SrcLoc, [SrcLoc], String)] -> [String] forall a b. (a -> b) -> [a] -> [b] map (SrcLoc, [SrcLoc], String) -> String forall a. Located a => (a, [a], String) -> String showWarning ([(SrcLoc, [SrcLoc], String)] -> [String]) -> [(SrcLoc, [SrcLoc], String)] -> [String] forall a b. (a -> b) -> a -> b $ ((SrcLoc, [SrcLoc], String) -> (String, Int)) -> [(SrcLoc, [SrcLoc], String)] -> [(SrcLoc, [SrcLoc], String)] forall b a. Ord b => (a -> b) -> [a] -> [a] sortOn (Loc -> (String, Int) rep (Loc -> (String, Int)) -> ((SrcLoc, [SrcLoc], String) -> Loc) -> (SrcLoc, [SrcLoc], String) -> (String, Int) forall b c a. (b -> c) -> (a -> b) -> a -> c . (SrcLoc, [SrcLoc], String) -> Loc forall a b c. Located a => (a, b, c) -> Loc wloc) [(SrcLoc, [SrcLoc], String)] ws wloc :: (a, b, c) -> Loc wloc (a x, b _, c _) = a -> Loc forall a. Located a => a -> Loc locOf a x rep :: Loc -> (String, Int) rep Loc NoLoc = (String "", Int 0) rep (Loc Pos p Pos _) = (Pos -> String posFile Pos p, Pos -> Int posCoff Pos p) showWarning :: (a, [a], String) -> String showWarning (a loc, [], String w) = ShowS inRed (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 ":") 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) showWarning (a loc, [a] locs, String w) = ShowS inRed (String "Warning at\n" String -> ShowS forall a. [a] -> [a] -> [a] ++ Int -> [String] -> String prettyStacktrace Int 0 ((a -> String) -> [a] -> [String] forall a b. (a -> b) -> [a] -> [b] map a -> String forall a. Located a => a -> String locStr (a loca -> [a] -> [a] forall a. a -> [a] -> [a] :[a] locs))) 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) -- | A single warning at the given location. singleWarning :: SrcLoc -> String -> Warnings singleWarning :: SrcLoc -> String -> Warnings singleWarning SrcLoc loc = SrcLoc -> [SrcLoc] -> String -> Warnings singleWarning' SrcLoc loc [] -- | A single warning at the given location, but also with a stack -- trace (sort of) to the location. singleWarning' :: SrcLoc -> [SrcLoc] -> String -> Warnings singleWarning' :: SrcLoc -> [SrcLoc] -> String -> Warnings singleWarning' SrcLoc loc [SrcLoc] locs String problem = [(SrcLoc, [SrcLoc], String)] -> Warnings Warnings [(SrcLoc loc, [SrcLoc] locs, String problem)]