{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric  #-}

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 -> [FilePath]
cabalProjectFiles :: [FilePath]
    -- ^ files related to the cradle error
    -- i.e. .cabal, cabal.project, etc.
    } deriving (Int -> CradleErrorDetails -> ShowS
[CradleErrorDetails] -> ShowS
CradleErrorDetails -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CradleErrorDetails] -> ShowS
$cshowList :: [CradleErrorDetails] -> ShowS
show :: CradleErrorDetails -> FilePath
$cshow :: CradleErrorDetails -> FilePath
showsPrec :: Int -> CradleErrorDetails -> ShowS
$cshowsPrec :: Int -> CradleErrorDetails -> ShowS
Show, CradleErrorDetails -> CradleErrorDetails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CradleErrorDetails -> CradleErrorDetails -> Bool
$c/= :: CradleErrorDetails -> CradleErrorDetails -> Bool
== :: CradleErrorDetails -> CradleErrorDetails -> Bool
$c== :: CradleErrorDetails -> CradleErrorDetails -> Bool
Eq, Eq 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
min :: CradleErrorDetails -> CradleErrorDetails -> CradleErrorDetails
$cmin :: CradleErrorDetails -> CradleErrorDetails -> CradleErrorDetails
max :: CradleErrorDetails -> CradleErrorDetails -> CradleErrorDetails
$cmax :: CradleErrorDetails -> CradleErrorDetails -> CradleErrorDetails
>= :: CradleErrorDetails -> CradleErrorDetails -> Bool
$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
compare :: CradleErrorDetails -> CradleErrorDetails -> Ordering
$ccompare :: CradleErrorDetails -> CradleErrorDetails -> Ordering
Ord, ReadPrec [CradleErrorDetails]
ReadPrec CradleErrorDetails
Int -> ReadS CradleErrorDetails
ReadS [CradleErrorDetails]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CradleErrorDetails]
$creadListPrec :: ReadPrec [CradleErrorDetails]
readPrec :: ReadPrec CradleErrorDetails
$creadPrec :: ReadPrec CradleErrorDetails
readList :: ReadS [CradleErrorDetails]
$creadList :: ReadS [CradleErrorDetails]
readsPrec :: Int -> ReadS CradleErrorDetails
$creadsPrec :: Int -> ReadS CradleErrorDetails
Read, 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
$cto :: forall x. Rep CradleErrorDetails x -> CradleErrorDetails
$cfrom :: forall x. CradleErrorDetails -> Rep CradleErrorDetails x
Generic, [CradleErrorDetails] -> Encoding
[CradleErrorDetails] -> Value
CradleErrorDetails -> Encoding
CradleErrorDetails -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CradleErrorDetails] -> Encoding
$ctoEncodingList :: [CradleErrorDetails] -> Encoding
toJSONList :: [CradleErrorDetails] -> Value
$ctoJSONList :: [CradleErrorDetails] -> Value
toEncoding :: CradleErrorDetails -> Encoding
$ctoEncoding :: CradleErrorDetails -> Encoding
toJSON :: CradleErrorDetails -> Value
$ctoJSON :: CradleErrorDetails -> Value
Aeson.ToJSON, Value -> Parser [CradleErrorDetails]
Value -> Parser CradleErrorDetails
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CradleErrorDetails]
$cparseJSONList :: Value -> Parser [CradleErrorDetails]
parseJSON :: Value -> Parser CradleErrorDetails
$cparseJSON :: Value -> Parser 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 [FilePath]
deps ExitCode
_ec [FilePath]
ms) Cradle a
cradle NormalizedFilePath
nfp
  | forall a. Cradle a -> Bool
HieBios.isCabalCradle Cradle a
cradle =
      let (NormalizedFilePath
fp, ShowDiagnostic
showDiag, Diagnostic
diag) = forall a.
Maybe Text
-> Maybe DiagnosticSeverity
-> a
-> Text
-> (a, ShowDiagnostic, Diagnostic)
ideErrorWithSource (forall a. a -> Maybe a
Just Text
"cradle") (forall a. a -> Maybe a
Just DiagnosticSeverity
DiagnosticSeverity_Error) NormalizedFilePath
nfp forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
T.pack [FilePath]
userFriendlyMessage in
        (NormalizedFilePath
fp, ShowDiagnostic
showDiag, Diagnostic
diag{$sel:_data_:Diagnostic :: Maybe Value
_data_ = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
Aeson.toJSON CradleErrorDetails{cabalProjectFiles :: [FilePath]
cabalProjectFiles=[FilePath]
absDeps}})
  | Bool
otherwise = forall a.
Maybe Text
-> Maybe DiagnosticSeverity
-> a
-> Text
-> (a, ShowDiagnostic, Diagnostic)
ideErrorWithSource (forall a. a -> Maybe a
Just Text
"cradle") (forall a. a -> Maybe a
Just DiagnosticSeverity
DiagnosticSeverity_Error) NormalizedFilePath
nfp forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
T.pack [FilePath]
userFriendlyMessage
  where
    absDeps :: [FilePath]
absDeps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Cradle a -> FilePath
cradleRootDir Cradle a
cradle FilePath -> ShowS
</>) [FilePath]
deps
    userFriendlyMessage :: [String]
    userFriendlyMessage :: [FilePath]
userFriendlyMessage
      | forall a. Cradle a -> Bool
HieBios.isCabalCradle Cradle a
cradle = forall a. a -> Maybe a -> a
fromMaybe [FilePath]
ms forall a b. (a -> b) -> a -> b
$ Maybe [FilePath]
fileMissingMessage forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [FilePath]
mkUnknownModuleMessage
      | Bool
otherwise = [FilePath]
ms

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

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

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

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

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

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

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

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

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

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