-- | 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,
    anyWarnings,
    singleWarning,
    singleWarning',
  )
where

import Data.List (sortOn)
import Data.Monoid
import Futhark.Util.Console (inRed)
import Futhark.Util.Loc
import Futhark.Util.Pretty
import Language.Futhark.Core (locStr, prettyStacktrace)
import Prelude

-- | The warnings produced by the compiler.  The 'Show' instance
-- produces a human-readable description.
newtype Warnings = Warnings [(SrcLoc, [SrcLoc], Doc)]

instance Semigroup Warnings where
  Warnings [(SrcLoc, [SrcLoc], Doc)]
ws1 <> :: Warnings -> Warnings -> Warnings
<> Warnings [(SrcLoc, [SrcLoc], Doc)]
ws2 = [(SrcLoc, [SrcLoc], Doc)] -> Warnings
Warnings ([(SrcLoc, [SrcLoc], Doc)] -> Warnings)
-> [(SrcLoc, [SrcLoc], Doc)] -> Warnings
forall a b. (a -> b) -> a -> b
$ [(SrcLoc, [SrcLoc], Doc)]
ws1 [(SrcLoc, [SrcLoc], Doc)]
-> [(SrcLoc, [SrcLoc], Doc)] -> [(SrcLoc, [SrcLoc], Doc)]
forall a. Semigroup a => a -> a -> a
<> [(SrcLoc, [SrcLoc], Doc)]
ws2

instance Monoid Warnings where
  mempty :: Warnings
mempty = [(SrcLoc, [SrcLoc], Doc)] -> Warnings
Warnings [(SrcLoc, [SrcLoc], Doc)]
forall a. Monoid a => a
mempty

instance Pretty Warnings where
  ppr :: Warnings -> Doc
ppr (Warnings []) = Doc
forall a. Monoid a => a
mempty
  ppr (Warnings [(SrcLoc, [SrcLoc], Doc)]
ws) =
    [Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
line ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ((SrcLoc, [SrcLoc], Doc) -> Doc)
-> [(SrcLoc, [SrcLoc], Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (SrcLoc, [SrcLoc], Doc) -> Doc
forall a. Located a => (a, [a], Doc) -> Doc
onWarning ([(SrcLoc, [SrcLoc], Doc)] -> [Doc])
-> [(SrcLoc, [SrcLoc], Doc)] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ((SrcLoc, [SrcLoc], Doc) -> ([Char], Int))
-> [(SrcLoc, [SrcLoc], Doc)] -> [(SrcLoc, [SrcLoc], Doc)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Loc -> ([Char], Int)
rep (Loc -> ([Char], Int))
-> ((SrcLoc, [SrcLoc], Doc) -> Loc)
-> (SrcLoc, [SrcLoc], Doc)
-> ([Char], Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcLoc, [SrcLoc], Doc) -> Loc
forall a b c. Located a => (a, b, c) -> Loc
wloc) [(SrcLoc, [SrcLoc], Doc)]
ws
    where
      wloc :: (a, b, c) -> Loc
wloc (a
x, b
_, c
_) = a -> Loc
forall a. Located a => a -> Loc
locOf a
x
      rep :: Loc -> ([Char], Int)
rep Loc
NoLoc = ([Char]
"", Int
0)
      rep (Loc Pos
p Pos
_) = (Pos -> [Char]
posFile Pos
p, Pos -> Int
posCoff Pos
p)
      onWarning :: (a, [a], Doc) -> Doc
onWarning (a
loc, [], Doc
w) =
        [Char] -> Doc
text ([Char] -> [Char]
inRed ([Char]
"Warning at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Located a => a -> [Char]
locStr a
loc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":"))
          Doc -> Doc -> Doc
</> Int -> Doc -> Doc
indent Int
2 Doc
w
      onWarning (a
loc, [a]
locs, Doc
w) =
        [Char] -> Doc
text
          ( [Char] -> [Char]
inRed
              ( [Char]
"Warning at\n"
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [[Char]] -> [Char]
prettyStacktrace Int
0 ((a -> [Char]) -> [a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
forall a. Located a => a -> [Char]
locStr (a
loc a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
locs))
              )
          )
          Doc -> Doc -> Doc
</> Int -> Doc -> Doc
indent Int
2 Doc
w

-- | True if there are any warnings in the set.
anyWarnings :: Warnings -> Bool
anyWarnings :: Warnings -> Bool
anyWarnings (Warnings [(SrcLoc, [SrcLoc], Doc)]
ws) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(SrcLoc, [SrcLoc], Doc)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SrcLoc, [SrcLoc], Doc)]
ws

-- | A single warning at the given location.
singleWarning :: SrcLoc -> Doc -> Warnings
singleWarning :: SrcLoc -> Doc -> Warnings
singleWarning SrcLoc
loc = SrcLoc -> [SrcLoc] -> Doc -> 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] -> Doc -> Warnings
singleWarning' :: SrcLoc -> [SrcLoc] -> Doc -> Warnings
singleWarning' SrcLoc
loc [SrcLoc]
locs Doc
problem = [(SrcLoc, [SrcLoc], Doc)] -> Warnings
Warnings [(SrcLoc
loc, [SrcLoc]
locs, Doc
problem)]