{-# 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)]