{-# LANGUAGE DeriveAnyClass #-}

module Development.IDE.Session.Diagnostics where
import           Control.Applicative
import           Control.Monad
import qualified Data.Aeson                        as Aeson
import           Data.List
import           Data.List.Extra                   (split)
import           Data.Maybe
import qualified Data.Text                         as T
import           Development.IDE.Types.Diagnostics
import           Development.IDE.Types.Location
import           GHC.Generics
import qualified HIE.Bios.Cradle                   as HieBios
import           HIE.Bios.Types                    hiding (Log)
import           System.FilePath

data CradleErrorDetails =
  CradleErrorDetails
    { CradleErrorDetails -> [String]
cabalProjectFiles :: [FilePath]
    -- ^ files related to the cradle error
    -- i.e. .cabal, cabal.project, etc.
    } deriving (Int -> CradleErrorDetails -> ShowS
[CradleErrorDetails] -> ShowS
CradleErrorDetails -> String
(Int -> CradleErrorDetails -> ShowS)
-> (CradleErrorDetails -> String)
-> ([CradleErrorDetails] -> ShowS)
-> Show CradleErrorDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CradleErrorDetails -> ShowS
showsPrec :: Int -> CradleErrorDetails -> ShowS
$cshow :: CradleErrorDetails -> String
show :: CradleErrorDetails -> String
$cshowList :: [CradleErrorDetails] -> ShowS
showList :: [CradleErrorDetails] -> ShowS
Show, CradleErrorDetails -> CradleErrorDetails -> Bool
(CradleErrorDetails -> CradleErrorDetails -> Bool)
-> (CradleErrorDetails -> CradleErrorDetails -> Bool)
-> Eq CradleErrorDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CradleErrorDetails -> CradleErrorDetails -> Bool
== :: CradleErrorDetails -> CradleErrorDetails -> Bool
$c/= :: CradleErrorDetails -> CradleErrorDetails -> Bool
/= :: CradleErrorDetails -> CradleErrorDetails -> Bool
Eq, Eq CradleErrorDetails
Eq CradleErrorDetails =>
(CradleErrorDetails -> CradleErrorDetails -> Ordering)
-> (CradleErrorDetails -> CradleErrorDetails -> Bool)
-> (CradleErrorDetails -> CradleErrorDetails -> Bool)
-> (CradleErrorDetails -> CradleErrorDetails -> Bool)
-> (CradleErrorDetails -> CradleErrorDetails -> Bool)
-> (CradleErrorDetails -> CradleErrorDetails -> CradleErrorDetails)
-> (CradleErrorDetails -> CradleErrorDetails -> CradleErrorDetails)
-> Ord CradleErrorDetails
CradleErrorDetails -> CradleErrorDetails -> Bool
CradleErrorDetails -> CradleErrorDetails -> Ordering
CradleErrorDetails -> CradleErrorDetails -> CradleErrorDetails
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
$ccompare :: CradleErrorDetails -> CradleErrorDetails -> Ordering
compare :: CradleErrorDetails -> CradleErrorDetails -> Ordering
$c< :: CradleErrorDetails -> CradleErrorDetails -> Bool
< :: CradleErrorDetails -> CradleErrorDetails -> Bool
$c<= :: CradleErrorDetails -> CradleErrorDetails -> Bool
<= :: CradleErrorDetails -> CradleErrorDetails -> Bool
$c> :: CradleErrorDetails -> CradleErrorDetails -> Bool
> :: CradleErrorDetails -> CradleErrorDetails -> Bool
$c>= :: CradleErrorDetails -> CradleErrorDetails -> Bool
>= :: CradleErrorDetails -> CradleErrorDetails -> Bool
$cmax :: CradleErrorDetails -> CradleErrorDetails -> CradleErrorDetails
max :: CradleErrorDetails -> CradleErrorDetails -> CradleErrorDetails
$cmin :: CradleErrorDetails -> CradleErrorDetails -> CradleErrorDetails
min :: CradleErrorDetails -> CradleErrorDetails -> CradleErrorDetails
Ord, ReadPrec [CradleErrorDetails]
ReadPrec CradleErrorDetails
Int -> ReadS CradleErrorDetails
ReadS [CradleErrorDetails]
(Int -> ReadS CradleErrorDetails)
-> ReadS [CradleErrorDetails]
-> ReadPrec CradleErrorDetails
-> ReadPrec [CradleErrorDetails]
-> Read CradleErrorDetails
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CradleErrorDetails
readsPrec :: Int -> ReadS CradleErrorDetails
$creadList :: ReadS [CradleErrorDetails]
readList :: ReadS [CradleErrorDetails]
$creadPrec :: ReadPrec CradleErrorDetails
readPrec :: ReadPrec CradleErrorDetails
$creadListPrec :: ReadPrec [CradleErrorDetails]
readListPrec :: ReadPrec [CradleErrorDetails]
Read, (forall x. CradleErrorDetails -> Rep CradleErrorDetails x)
-> (forall x. Rep CradleErrorDetails x -> CradleErrorDetails)
-> Generic CradleErrorDetails
forall x. Rep CradleErrorDetails x -> CradleErrorDetails
forall x. CradleErrorDetails -> Rep CradleErrorDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CradleErrorDetails -> Rep CradleErrorDetails x
from :: forall x. CradleErrorDetails -> Rep CradleErrorDetails x
$cto :: forall x. Rep CradleErrorDetails x -> CradleErrorDetails
to :: forall x. Rep CradleErrorDetails x -> CradleErrorDetails
Generic, [CradleErrorDetails] -> Value
[CradleErrorDetails] -> Encoding
CradleErrorDetails -> Bool
CradleErrorDetails -> Value
CradleErrorDetails -> Encoding
(CradleErrorDetails -> Value)
-> (CradleErrorDetails -> Encoding)
-> ([CradleErrorDetails] -> Value)
-> ([CradleErrorDetails] -> Encoding)
-> (CradleErrorDetails -> Bool)
-> ToJSON CradleErrorDetails
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CradleErrorDetails -> Value
toJSON :: CradleErrorDetails -> Value
$ctoEncoding :: CradleErrorDetails -> Encoding
toEncoding :: CradleErrorDetails -> Encoding
$ctoJSONList :: [CradleErrorDetails] -> Value
toJSONList :: [CradleErrorDetails] -> Value
$ctoEncodingList :: [CradleErrorDetails] -> Encoding
toEncodingList :: [CradleErrorDetails] -> Encoding
$comitField :: CradleErrorDetails -> Bool
omitField :: CradleErrorDetails -> Bool
Aeson.ToJSON, Maybe CradleErrorDetails
Value -> Parser [CradleErrorDetails]
Value -> Parser CradleErrorDetails
(Value -> Parser CradleErrorDetails)
-> (Value -> Parser [CradleErrorDetails])
-> Maybe CradleErrorDetails
-> FromJSON CradleErrorDetails
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser CradleErrorDetails
parseJSON :: Value -> Parser CradleErrorDetails
$cparseJSONList :: Value -> Parser [CradleErrorDetails]
parseJSONList :: Value -> Parser [CradleErrorDetails]
$comittedField :: Maybe CradleErrorDetails
omittedField :: Maybe CradleErrorDetails
Aeson.FromJSON)

{- | Takes a cradle error, the corresponding cradle and the file path where
  the cradle error occurred (of the file we attempted to load).
  Depicts the cradle error in a user-friendly way.
-}
renderCradleError :: CradleError -> Cradle a -> NormalizedFilePath -> FileDiagnostic
renderCradleError :: forall a.
CradleError -> Cradle a -> NormalizedFilePath -> FileDiagnostic
renderCradleError (CradleError [String]
deps ExitCode
_ec [String]
ms) Cradle a
cradle NormalizedFilePath
nfp
  | Cradle a -> Bool
forall a. Cradle a -> Bool
HieBios.isCabalCradle Cradle a
cradle =
      let (NormalizedFilePath
fp, ShowDiagnostic
showDiag, Diagnostic
diag) = Maybe Text
-> Maybe DiagnosticSeverity
-> NormalizedFilePath
-> Text
-> FileDiagnostic
forall a.
Maybe Text
-> Maybe DiagnosticSeverity
-> a
-> Text
-> (a, ShowDiagnostic, Diagnostic)
ideErrorWithSource (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"cradle") (DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DiagnosticSeverity_Error) NormalizedFilePath
nfp (Text -> FileDiagnostic) -> Text -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
userFriendlyMessage in
        (NormalizedFilePath
fp, ShowDiagnostic
showDiag, Diagnostic
diag{_data_ = Just $ Aeson.toJSON CradleErrorDetails{cabalProjectFiles=absDeps}})
  | Bool
otherwise = Maybe Text
-> Maybe DiagnosticSeverity
-> NormalizedFilePath
-> Text
-> FileDiagnostic
forall a.
Maybe Text
-> Maybe DiagnosticSeverity
-> a
-> Text
-> (a, ShowDiagnostic, Diagnostic)
ideErrorWithSource (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"cradle") (DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DiagnosticSeverity_Error) NormalizedFilePath
nfp (Text -> FileDiagnostic) -> Text -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
userFriendlyMessage
  where
    absDeps :: [String]
absDeps = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Cradle a -> String
forall a. Cradle a -> String
cradleRootDir Cradle a
cradle </>) [String]
deps
    userFriendlyMessage :: [String]
    userFriendlyMessage :: [String]
userFriendlyMessage
      | Cradle a -> Bool
forall a. Cradle a -> Bool
HieBios.isCabalCradle Cradle a
cradle = [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [String]
ms (Maybe [String] -> [String]) -> Maybe [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Maybe [String]
fileMissingMessage Maybe [String] -> Maybe [String] -> Maybe [String]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [String]
mkUnknownModuleMessage
      | Bool
otherwise = [String]
ms

    mkUnknownModuleMessage :: Maybe [String]
    mkUnknownModuleMessage :: Maybe [String]
mkUnknownModuleMessage
      | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"Failed extracting script block:") [String]
ms =
          [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
unknownModuleMessage (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
nfp)
      | Bool
otherwise = Maybe [String]
forall a. Maybe a
Nothing

    fileMissingMessage :: Maybe [String]
    fileMissingMessage :: Maybe [String]
fileMissingMessage =
      MultiCradleErr -> [String]
multiCradleErrMessage (MultiCradleErr -> [String])
-> Maybe MultiCradleErr -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Maybe MultiCradleErr
parseMultiCradleErr [String]
ms

-- | Information included in Multi Cradle error messages
data MultiCradleErr = MultiCradleErr
  { MultiCradleErr -> String
mcPwd      :: FilePath
  , MultiCradleErr -> String
mcFilePath :: FilePath
  , MultiCradleErr -> [(String, String)]
mcPrefixes :: [(FilePath, String)]
  } deriving (Int -> MultiCradleErr -> ShowS
[MultiCradleErr] -> ShowS
MultiCradleErr -> String
(Int -> MultiCradleErr -> ShowS)
-> (MultiCradleErr -> String)
-> ([MultiCradleErr] -> ShowS)
-> Show MultiCradleErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MultiCradleErr -> ShowS
showsPrec :: Int -> MultiCradleErr -> ShowS
$cshow :: MultiCradleErr -> String
show :: MultiCradleErr -> String
$cshowList :: [MultiCradleErr] -> ShowS
showList :: [MultiCradleErr] -> ShowS
Show)

-- | Attempt to parse a multi-cradle message
parseMultiCradleErr :: [String] -> Maybe MultiCradleErr
parseMultiCradleErr :: [String] -> Maybe MultiCradleErr
parseMultiCradleErr [String]
ms = do
  String
_  <- String -> Maybe String
lineAfter String
"Multi Cradle: "
  String
wd <- String -> Maybe String
lineAfter String
"pwd: "
  String
fp <- String -> Maybe String
lineAfter String
"filepath: "
  [(String, String)]
ps <- Maybe [(String, String)]
prefixes
  MultiCradleErr -> Maybe MultiCradleErr
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultiCradleErr -> Maybe MultiCradleErr)
-> MultiCradleErr -> Maybe MultiCradleErr
forall a b. (a -> b) -> a -> b
$ String -> String -> [(String, String)] -> MultiCradleErr
MultiCradleErr String
wd String
fp [(String, String)]
ps

  where
    lineAfter :: String -> Maybe String
    lineAfter :: String -> Maybe String
lineAfter String
pre = [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ (String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
pre) [String]
ms

    prefixes :: Maybe [(FilePath, String)]
    prefixes :: Maybe [(String, String)]
prefixes = do
      [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, String)] -> Maybe [(String, String)])
-> [(String, String)] -> Maybe [(String, String)]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe (String, String))
-> [String] -> [(String, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe (String, String)
tuple [String]
ms

    tuple :: String -> Maybe (String, String)
    tuple :: String -> Maybe (String, String)
tuple String
line = do
      String
line' <- Char -> String -> Char -> Maybe String
surround Char
'(' String
line Char
')'
      [String
f, String
s] <- [String] -> Maybe [String]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') String
line'
      (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
f, String
s)

    -- extracts the string surrounded by required characters
    surround :: Char -> String -> Char -> Maybe String
    surround :: Char -> String -> Char -> Maybe String
surround Char
start String
s Char
end = do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String -> Maybe Char
forall a. [a] -> Maybe a
listToMaybe String
s Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
start)
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String -> Maybe Char
forall a. [a] -> Maybe a
listToMaybe (ShowS
forall a. [a] -> [a]
reverse String
s) Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
end)
      String -> Maybe String
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
s

multiCradleErrMessage :: MultiCradleErr -> [String]
multiCradleErrMessage :: MultiCradleErr -> [String]
multiCradleErrMessage MultiCradleErr
e =
    String -> [String]
unknownModuleMessage (MultiCradleErr -> String
mcFilePath MultiCradleErr
e)
    [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
""]
    [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall {a}. (Semigroup a, IsString a) => (a, a) -> a
prefix (MultiCradleErr -> [(String, String)]
mcPrefixes MultiCradleErr
e)
  where
    prefix :: (a, a) -> a
prefix (a
f, a
r) = a
f a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" - " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
r

unknownModuleMessage :: String -> [String]
unknownModuleMessage :: String -> [String]
unknownModuleMessage String
moduleFileName =
  [ String
"Loading the module '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
moduleFileName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' failed."
  , String
""
  , String
"It may not be listed in your .cabal file!"
  , String
"Perhaps you need to add `"String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
dropExtension (ShowS
takeFileName String
moduleFileName) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"` to other-modules or exposed-modules."
  , String
""
  , String
"For more information, visit: https://cabal.readthedocs.io/en/3.4/developing-packages.html#modules-included-in-the-package"
  ]