{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}

module HsDev.Tools.Types (
	Severity(..),
	Note(..), noteSource, noteRegion, noteLevel, note,
	OutputMessage(..), message, messageSuggestion, outputMessage
	) where

import Control.DeepSeq (NFData(..))
import Control.Lens (makeLenses)
import Control.Monad
import Data.Aeson hiding (Error)
import Data.Text (Text)

import System.Directory.Paths
import HsDev.Symbols.Location
import HsDev.Util ((.::), (.::?), noNulls)

-- | Note severity
data Severity = Error | Warning | Hint deriving (Int -> Severity
Severity -> Int
Severity -> [Severity]
Severity -> Severity
Severity -> Severity -> [Severity]
Severity -> Severity -> Severity -> [Severity]
(Severity -> Severity)
-> (Severity -> Severity)
-> (Int -> Severity)
-> (Severity -> Int)
-> (Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> Severity -> [Severity])
-> Enum Severity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
$cenumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
enumFromTo :: Severity -> Severity -> [Severity]
$cenumFromTo :: Severity -> Severity -> [Severity]
enumFromThen :: Severity -> Severity -> [Severity]
$cenumFromThen :: Severity -> Severity -> [Severity]
enumFrom :: Severity -> [Severity]
$cenumFrom :: Severity -> [Severity]
fromEnum :: Severity -> Int
$cfromEnum :: Severity -> Int
toEnum :: Int -> Severity
$ctoEnum :: Int -> Severity
pred :: Severity -> Severity
$cpred :: Severity -> Severity
succ :: Severity -> Severity
$csucc :: Severity -> Severity
Enum, Severity
Severity -> Severity -> Bounded Severity
forall a. a -> a -> Bounded a
maxBound :: Severity
$cmaxBound :: Severity
minBound :: Severity
$cminBound :: Severity
Bounded, Severity -> Severity -> Bool
(Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool) -> Eq Severity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c== :: Severity -> Severity -> Bool
Eq, Eq Severity
Eq Severity
-> (Severity -> Severity -> Ordering)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Severity)
-> (Severity -> Severity -> Severity)
-> Ord Severity
Severity -> Severity -> Bool
Severity -> Severity -> Ordering
Severity -> Severity -> Severity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmax :: Severity -> Severity -> Severity
>= :: Severity -> Severity -> Bool
$c>= :: Severity -> Severity -> Bool
> :: Severity -> Severity -> Bool
$c> :: Severity -> Severity -> Bool
<= :: Severity -> Severity -> Bool
$c<= :: Severity -> Severity -> Bool
< :: Severity -> Severity -> Bool
$c< :: Severity -> Severity -> Bool
compare :: Severity -> Severity -> Ordering
$ccompare :: Severity -> Severity -> Ordering
$cp1Ord :: Eq Severity
Ord, ReadPrec [Severity]
ReadPrec Severity
Int -> ReadS Severity
ReadS [Severity]
(Int -> ReadS Severity)
-> ReadS [Severity]
-> ReadPrec Severity
-> ReadPrec [Severity]
-> Read Severity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Severity]
$creadListPrec :: ReadPrec [Severity]
readPrec :: ReadPrec Severity
$creadPrec :: ReadPrec Severity
readList :: ReadS [Severity]
$creadList :: ReadS [Severity]
readsPrec :: Int -> ReadS Severity
$creadsPrec :: Int -> ReadS Severity
Read, Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
(Int -> Severity -> ShowS)
-> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> String
$cshow :: Severity -> String
showsPrec :: Int -> Severity -> ShowS
$cshowsPrec :: Int -> Severity -> ShowS
Show)

instance NFData Severity where
	rnf :: Severity -> ()
rnf Severity
Error = ()
	rnf Severity
Warning = ()
	rnf Severity
Hint = ()

instance ToJSON Severity where
	toJSON :: Severity -> Value
toJSON Severity
Error = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"error" :: String)
	toJSON Severity
Warning = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"warning" :: String)
	toJSON Severity
Hint = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"hint" :: String)

instance FromJSON Severity where
	parseJSON :: Value -> Parser Severity
parseJSON Value
v = do
		String
s <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
		[Parser Severity] -> Parser Severity
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [
			Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"error" :: String)) Parser () -> Parser Severity -> Parser Severity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Severity -> Parser Severity
forall (m :: * -> *) a. Monad m => a -> m a
return Severity
Error,
			Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"warning" :: String)) Parser () -> Parser Severity -> Parser Severity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Severity -> Parser Severity
forall (m :: * -> *) a. Monad m => a -> m a
return Severity
Warning,
			Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"hint" :: String)) Parser () -> Parser Severity -> Parser Severity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Severity -> Parser Severity
forall (m :: * -> *) a. Monad m => a -> m a
return Severity
Hint,
			String -> Parser Severity
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Severity) -> String -> Parser Severity
forall a b. (a -> b) -> a -> b
$ String
"Unknown severity: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s]

-- | Note over some region
data Note a = Note {
	Note a -> ModuleLocation
_noteSource :: ModuleLocation,
	Note a -> Region
_noteRegion :: Region,
	Note a -> Maybe Severity
_noteLevel :: Maybe Severity,
	Note a -> a
_note :: a }
		deriving (Note a -> Note a -> Bool
(Note a -> Note a -> Bool)
-> (Note a -> Note a -> Bool) -> Eq (Note a)
forall a. Eq a => Note a -> Note a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note a -> Note a -> Bool
$c/= :: forall a. Eq a => Note a -> Note a -> Bool
== :: Note a -> Note a -> Bool
$c== :: forall a. Eq a => Note a -> Note a -> Bool
Eq, Int -> Note a -> ShowS
[Note a] -> ShowS
Note a -> String
(Int -> Note a -> ShowS)
-> (Note a -> String) -> ([Note a] -> ShowS) -> Show (Note a)
forall a. Show a => Int -> Note a -> ShowS
forall a. Show a => [Note a] -> ShowS
forall a. Show a => Note a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note a] -> ShowS
$cshowList :: forall a. Show a => [Note a] -> ShowS
show :: Note a -> String
$cshow :: forall a. Show a => Note a -> String
showsPrec :: Int -> Note a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Note a -> ShowS
Show)

makeLenses ''Note

instance Ord a => Ord (Note a) where
	compare :: Note a -> Note a -> Ordering
compare (Note ModuleLocation
lsrc Region
lrgn Maybe Severity
llev a
lnote) (Note ModuleLocation
rsrc Region
rrgn Maybe Severity
rlev a
rnote) = (ModuleLocation, Region, Maybe Severity, a)
-> (ModuleLocation, Region, Maybe Severity, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ModuleLocation
lsrc, Region
lrgn, Maybe Severity
llev, a
lnote) (ModuleLocation
rsrc, Region
rrgn, Maybe Severity
rlev, a
rnote)

instance Functor Note where
	fmap :: (a -> b) -> Note a -> Note b
fmap a -> b
f (Note ModuleLocation
s Region
r Maybe Severity
l a
n) = ModuleLocation -> Region -> Maybe Severity -> b -> Note b
forall a. ModuleLocation -> Region -> Maybe Severity -> a -> Note a
Note ModuleLocation
s Region
r Maybe Severity
l (a -> b
f a
n)

instance NFData a => NFData (Note a) where
	rnf :: Note a -> ()
rnf (Note ModuleLocation
s Region
r Maybe Severity
l a
n) = ModuleLocation -> ()
forall a. NFData a => a -> ()
rnf ModuleLocation
s () -> () -> ()
`seq` Region -> ()
forall a. NFData a => a -> ()
rnf Region
r () -> () -> ()
`seq` Maybe Severity -> ()
forall a. NFData a => a -> ()
rnf Maybe Severity
l () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
n

instance ToJSON a => ToJSON (Note a) where
	toJSON :: Note a -> Value
toJSON (Note ModuleLocation
s Region
r Maybe Severity
l a
n) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> [Pair]
noNulls [
		Text
"source" Text -> ModuleLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ModuleLocation
s,
		Text
"region" Text -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Region
r,
		Text
"level" Text -> Maybe Severity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Severity
l,
		Text
"note" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
n]

instance FromJSON a => FromJSON (Note a) where
	parseJSON :: Value -> Parser (Note a)
parseJSON = String -> (Object -> Parser (Note a)) -> Value -> Parser (Note a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"note" ((Object -> Parser (Note a)) -> Value -> Parser (Note a))
-> (Object -> Parser (Note a)) -> Value -> Parser (Note a)
forall a b. (a -> b) -> a -> b
$ \Object
v -> ModuleLocation -> Region -> Maybe Severity -> a -> Note a
forall a. ModuleLocation -> Region -> Maybe Severity -> a -> Note a
Note (ModuleLocation -> Region -> Maybe Severity -> a -> Note a)
-> Parser ModuleLocation
-> Parser (Region -> Maybe Severity -> a -> Note a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Object
v Object -> Text -> Parser ModuleLocation
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"source" Parser (Region -> Maybe Severity -> a -> Note a)
-> Parser Region -> Parser (Maybe Severity -> a -> Note a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser Region
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"region" Parser (Maybe Severity -> a -> Note a)
-> Parser (Maybe Severity) -> Parser (a -> Note a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser (Maybe Severity)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"level" Parser (a -> Note a) -> Parser a -> Parser (Note a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"note"

instance RecalcTabs (Note a) where
	recalcTabs :: Text -> Int -> Note a -> Note a
recalcTabs Text
cts Int
n' (Note ModuleLocation
s Region
r Maybe Severity
l a
n) = ModuleLocation -> Region -> Maybe Severity -> a -> Note a
forall a. ModuleLocation -> Region -> Maybe Severity -> a -> Note a
Note ModuleLocation
s (Text -> Int -> Region -> Region
forall a. RecalcTabs a => Text -> Int -> a -> a
recalcTabs Text
cts Int
n' Region
r) Maybe Severity
l a
n
	calcTabs :: Text -> Int -> Note a -> Note a
calcTabs Text
cts Int
n' (Note ModuleLocation
s Region
r Maybe Severity
l a
n) = ModuleLocation -> Region -> Maybe Severity -> a -> Note a
forall a. ModuleLocation -> Region -> Maybe Severity -> a -> Note a
Note ModuleLocation
s (Text -> Int -> Region -> Region
forall a. RecalcTabs a => Text -> Int -> a -> a
calcTabs Text
cts Int
n' Region
r) Maybe Severity
l a
n

instance Paths (Note a) where
	paths :: (String -> f String) -> Note a -> f (Note a)
paths String -> f String
f (Note ModuleLocation
s Region
r Maybe Severity
l a
n) = ModuleLocation -> Region -> Maybe Severity -> a -> Note a
forall a. ModuleLocation -> Region -> Maybe Severity -> a -> Note a
Note (ModuleLocation -> Region -> Maybe Severity -> a -> Note a)
-> f ModuleLocation -> f (Region -> Maybe Severity -> a -> Note a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> ModuleLocation -> f ModuleLocation
forall a. Paths a => Traversal' a String
paths String -> f String
f ModuleLocation
s f (Region -> Maybe Severity -> a -> Note a)
-> f Region -> f (Maybe Severity -> a -> Note a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Region -> f Region
forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
r f (Maybe Severity -> a -> Note a)
-> f (Maybe Severity) -> f (a -> Note a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Severity -> f (Maybe Severity)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Severity
l f (a -> Note a) -> f a -> f (Note a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
n

-- | Output message from some tool (ghc, ghc-mod, hlint) with optional suggestion
data OutputMessage = OutputMessage {
	OutputMessage -> Text
_message :: Text,
	OutputMessage -> Maybe Text
_messageSuggestion :: Maybe Text }
		deriving (OutputMessage -> OutputMessage -> Bool
(OutputMessage -> OutputMessage -> Bool)
-> (OutputMessage -> OutputMessage -> Bool) -> Eq OutputMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputMessage -> OutputMessage -> Bool
$c/= :: OutputMessage -> OutputMessage -> Bool
== :: OutputMessage -> OutputMessage -> Bool
$c== :: OutputMessage -> OutputMessage -> Bool
Eq, Eq OutputMessage
Eq OutputMessage
-> (OutputMessage -> OutputMessage -> Ordering)
-> (OutputMessage -> OutputMessage -> Bool)
-> (OutputMessage -> OutputMessage -> Bool)
-> (OutputMessage -> OutputMessage -> Bool)
-> (OutputMessage -> OutputMessage -> Bool)
-> (OutputMessage -> OutputMessage -> OutputMessage)
-> (OutputMessage -> OutputMessage -> OutputMessage)
-> Ord OutputMessage
OutputMessage -> OutputMessage -> Bool
OutputMessage -> OutputMessage -> Ordering
OutputMessage -> OutputMessage -> OutputMessage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OutputMessage -> OutputMessage -> OutputMessage
$cmin :: OutputMessage -> OutputMessage -> OutputMessage
max :: OutputMessage -> OutputMessage -> OutputMessage
$cmax :: OutputMessage -> OutputMessage -> OutputMessage
>= :: OutputMessage -> OutputMessage -> Bool
$c>= :: OutputMessage -> OutputMessage -> Bool
> :: OutputMessage -> OutputMessage -> Bool
$c> :: OutputMessage -> OutputMessage -> Bool
<= :: OutputMessage -> OutputMessage -> Bool
$c<= :: OutputMessage -> OutputMessage -> Bool
< :: OutputMessage -> OutputMessage -> Bool
$c< :: OutputMessage -> OutputMessage -> Bool
compare :: OutputMessage -> OutputMessage -> Ordering
$ccompare :: OutputMessage -> OutputMessage -> Ordering
$cp1Ord :: Eq OutputMessage
Ord, ReadPrec [OutputMessage]
ReadPrec OutputMessage
Int -> ReadS OutputMessage
ReadS [OutputMessage]
(Int -> ReadS OutputMessage)
-> ReadS [OutputMessage]
-> ReadPrec OutputMessage
-> ReadPrec [OutputMessage]
-> Read OutputMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OutputMessage]
$creadListPrec :: ReadPrec [OutputMessage]
readPrec :: ReadPrec OutputMessage
$creadPrec :: ReadPrec OutputMessage
readList :: ReadS [OutputMessage]
$creadList :: ReadS [OutputMessage]
readsPrec :: Int -> ReadS OutputMessage
$creadsPrec :: Int -> ReadS OutputMessage
Read, Int -> OutputMessage -> ShowS
[OutputMessage] -> ShowS
OutputMessage -> String
(Int -> OutputMessage -> ShowS)
-> (OutputMessage -> String)
-> ([OutputMessage] -> ShowS)
-> Show OutputMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputMessage] -> ShowS
$cshowList :: [OutputMessage] -> ShowS
show :: OutputMessage -> String
$cshow :: OutputMessage -> String
showsPrec :: Int -> OutputMessage -> ShowS
$cshowsPrec :: Int -> OutputMessage -> ShowS
Show)

instance NFData OutputMessage where
	rnf :: OutputMessage -> ()
rnf (OutputMessage Text
m Maybe Text
s) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
m () -> () -> ()
`seq` Maybe Text -> ()
forall a. NFData a => a -> ()
rnf Maybe Text
s

instance ToJSON OutputMessage where
	toJSON :: OutputMessage -> Value
toJSON (OutputMessage Text
m Maybe Text
s) = [Pair] -> Value
object [
		Text
"message" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
m,
		Text
"suggestion" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
s]

instance FromJSON OutputMessage where
	parseJSON :: Value -> Parser OutputMessage
parseJSON = String
-> (Object -> Parser OutputMessage)
-> Value
-> Parser OutputMessage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"output-message" ((Object -> Parser OutputMessage) -> Value -> Parser OutputMessage)
-> (Object -> Parser OutputMessage)
-> Value
-> Parser OutputMessage
forall a b. (a -> b) -> a -> b
$ \Object
v -> Text -> Maybe Text -> OutputMessage
OutputMessage (Text -> Maybe Text -> OutputMessage)
-> Parser Text -> Parser (Maybe Text -> OutputMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"message" Parser (Maybe Text -> OutputMessage)
-> Parser (Maybe Text) -> Parser OutputMessage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"suggestion"

outputMessage :: Text -> OutputMessage
outputMessage :: Text -> OutputMessage
outputMessage Text
msg = Text -> Maybe Text -> OutputMessage
OutputMessage Text
msg Maybe Text
forall a. Maybe a
Nothing

makeLenses ''OutputMessage