module Language.PureScript.Ide.Error
( IdeError(..)
, prettyPrintTypeSingleLine
) where
import Data.Aeson (KeyValue(..), ToJSON(..), Value, object)
import Data.Aeson.Types qualified as Aeson
import Data.Aeson.KeyMap qualified as KM
import Data.Text qualified as T
import Language.PureScript qualified as P
import Language.PureScript.Errors.JSON (toJSONError)
import Language.PureScript.Ide.Types (ModuleIdent, Completion(..))
import Protolude
data IdeError
= GeneralError Text
| NotFound Text
| ModuleNotFound ModuleIdent
| ModuleFileNotFound ModuleIdent
| RebuildError [(FilePath, Text)] P.MultipleErrors
deriving (Int -> IdeError -> ShowS
[IdeError] -> ShowS
IdeError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeError] -> ShowS
$cshowList :: [IdeError] -> ShowS
show :: IdeError -> String
$cshow :: IdeError -> String
showsPrec :: Int -> IdeError -> ShowS
$cshowsPrec :: Int -> IdeError -> ShowS
Show)
instance ToJSON IdeError where
toJSON :: IdeError -> Value
toJSON (RebuildError [(String, Text)]
files MultipleErrors
errs) = [Pair] -> Value
object
[ Key
"resultType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"error" :: Text)
, Key
"result" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(String, Text)] -> MultipleErrors -> Value
encodeRebuildErrors [(String, Text)]
files MultipleErrors
errs
]
toJSON IdeError
err = [Pair] -> Value
object
[ Key
"resultType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"error" :: Text)
, Key
"result" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= IdeError -> Text
textError IdeError
err
]
encodeRebuildErrors :: [(FilePath, Text)] -> P.MultipleErrors -> Value
encodeRebuildErrors :: [(String, Text)] -> MultipleErrors -> Value
encodeRebuildErrors [(String, Text)]
files = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ErrorMessage -> Value
encodeRebuildError forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultipleErrors -> [ErrorMessage]
P.runMultipleErrors
where
encodeRebuildError :: ErrorMessage -> Value
encodeRebuildError ErrorMessage
err = case ErrorMessage
err of
(P.ErrorMessage [ErrorMessageHint]
_
((P.HoleInferredType Text
name SourceType
_ Context
_
(Just P.TSAfter{tsAfterIdentifiers :: TypeSearch -> [(Qualified Text, SourceType)]
tsAfterIdentifiers=[(Qualified Text, SourceType)]
idents, tsAfterRecordFields :: TypeSearch -> Maybe [(Label, SourceType)]
tsAfterRecordFields=Maybe [(Label, SourceType)]
fields})))) ->
forall {v} {a} {a}.
ToJSON v =>
v
-> [(Qualified Text, Type a)]
-> [(Label, Type a)]
-> Value
-> Value
insertTSCompletions Text
name [(Qualified Text, SourceType)]
idents (forall a. a -> Maybe a -> a
fromMaybe [] Maybe [(Label, SourceType)]
fields) (forall a. ToJSON a => a -> Value
toJSON (Bool -> Level -> [(String, Text)] -> ErrorMessage -> JSONError
toJSONError Bool
False Level
P.Error [(String, Text)]
files ErrorMessage
err))
ErrorMessage
_ ->
(forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Level -> [(String, Text)] -> ErrorMessage -> JSONError
toJSONError Bool
False Level
P.Error [(String, Text)]
files) ErrorMessage
err
insertTSCompletions :: v
-> [(Qualified Text, Type a)]
-> [(Label, Type a)]
-> Value
-> Value
insertTSCompletions v
name [(Qualified Text, Type a)]
idents [(Label, Type a)]
fields (Aeson.Object Object
value) =
Object -> Value
Aeson.Object
(forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert Key
"pursIde"
([Pair] -> Value
object [ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
name
, Key
"completions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Ord a => [a] -> [a]
ordNub (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall {a}. (Qualified Text, Type a) -> Completion
identCompletion [(Qualified Text, Type a)]
idents forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall {a}. (Label, Type a) -> Completion
fieldCompletion [(Label, Type a)]
fields)
]) Object
value)
insertTSCompletions v
_ [(Qualified Text, Type a)]
_ [(Label, Type a)]
_ Value
v = Value
v
identCompletion :: (Qualified Text, Type a) -> Completion
identCompletion (P.Qualified QualifiedBy
mn Text
i, Type a
ty) =
Completion
{ complModule :: Text
complModule = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ModuleName -> Text
P.runModuleName forall a b. (a -> b) -> a -> b
$ QualifiedBy -> Maybe ModuleName
P.toMaybeModuleName QualifiedBy
mn
, complIdentifier :: Text
complIdentifier = Text
i
, complType :: Text
complType = forall a. Type a -> Text
prettyPrintTypeSingleLine Type a
ty
, complExpandedType :: Text
complExpandedType = forall a. Type a -> Text
prettyPrintTypeSingleLine Type a
ty
, complLocation :: Maybe SourceSpan
complLocation = forall a. Maybe a
Nothing
, complDocumentation :: Maybe Text
complDocumentation = forall a. Maybe a
Nothing
, complExportedFrom :: [ModuleName]
complExportedFrom = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ QualifiedBy -> Maybe ModuleName
P.toMaybeModuleName QualifiedBy
mn
, complDeclarationType :: Maybe DeclarationType
complDeclarationType = forall a. Maybe a
Nothing
}
fieldCompletion :: (Label, Type a) -> Completion
fieldCompletion (Label
label, Type a
ty) =
Completion
{ complModule :: Text
complModule = Text
""
, complIdentifier :: Text
complIdentifier = Text
"_." forall a. Semigroup a => a -> a -> a
<> Label -> Text
P.prettyPrintLabel Label
label
, complType :: Text
complType = forall a. Type a -> Text
prettyPrintTypeSingleLine Type a
ty
, complExpandedType :: Text
complExpandedType = forall a. Type a -> Text
prettyPrintTypeSingleLine Type a
ty
, complLocation :: Maybe SourceSpan
complLocation = forall a. Maybe a
Nothing
, complDocumentation :: Maybe Text
complDocumentation = forall a. Maybe a
Nothing
, complExportedFrom :: [ModuleName]
complExportedFrom = []
, complDeclarationType :: Maybe DeclarationType
complDeclarationType = forall a. Maybe a
Nothing
}
textError :: IdeError -> Text
textError :: IdeError -> Text
textError (GeneralError Text
msg) = Text
msg
textError (NotFound Text
ident) = Text
"Symbol '" forall a. Semigroup a => a -> a -> a
<> Text
ident forall a. Semigroup a => a -> a -> a
<> Text
"' not found."
textError (ModuleNotFound Text
ident) = Text
"Module '" forall a. Semigroup a => a -> a -> a
<> Text
ident forall a. Semigroup a => a -> a -> a
<> Text
"' not found."
textError (ModuleFileNotFound Text
ident) = Text
"Extern file for module " forall a. Semigroup a => a -> a -> a
<> Text
ident forall a. Semigroup a => a -> a -> a
<> Text
" could not be found"
textError (RebuildError [(String, Text)]
_ MultipleErrors
err) = forall a b. (Show a, StringConv String b) => a -> b
show MultipleErrors
err
prettyPrintTypeSingleLine :: P.Type a -> Text
prettyPrintTypeSingleLine :: forall a. Type a -> Text
prettyPrintTypeSingleLine = [Text] -> Text
T.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Type a -> String
P.prettyPrintTypeWithUnicode forall a. Bounded a => a
maxBound