forked from purescript/purescript
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathError.hs
More file actions
97 lines (88 loc) · 3.58 KB
/
Error.hs
File metadata and controls
97 lines (88 loc) · 3.58 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
-----------------------------------------------------------------------------
--
-- Module : Language.PureScript.Ide.Error
-- Description : Error types for psc-ide
-- Copyright : Christoph Hegemann 2016
-- License : MIT (http://opensource.org/licenses/MIT)
--
-- Maintainer : Christoph Hegemann <christoph.hegemann1337@gmail.com>
-- Stability : experimental
--
-- |
-- Error types for psc-ide
-----------------------------------------------------------------------------
module Language.PureScript.Ide.Error
( IdeError(..)
, prettyPrintTypeSingleLine
) where
import Data.Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Text as T
import qualified Language.PureScript as P
import Language.PureScript.Errors.JSON
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 (Show)
instance ToJSON IdeError where
toJSON (RebuildError files errs) = object
[ "resultType" .= ("error" :: Text)
, "result" .= encodeRebuildErrors files errs
]
toJSON err = object
[ "resultType" .= ("error" :: Text)
, "result" .= textError err
]
encodeRebuildErrors :: [(FilePath, Text)] -> P.MultipleErrors -> Value
encodeRebuildErrors files = toJSON . map encodeRebuildError . P.runMultipleErrors
where
encodeRebuildError err = case err of
(P.ErrorMessage _
((P.HoleInferredType name _ _
(Just P.TSAfter{tsAfterIdentifiers=idents, tsAfterRecordFields=fields})))) ->
insertTSCompletions name idents (fromMaybe [] fields) (toJSON (toJSONError False P.Error files err))
_ ->
(toJSON . toJSONError False P.Error files) err
insertTSCompletions name idents fields (Aeson.Object value) =
Aeson.Object
(KM.insert "pursIde"
(object [ "name" .= name
, "completions" .= ordNub (map identCompletion idents ++ map fieldCompletion fields)
]) value)
insertTSCompletions _ _ _ v = v
identCompletion (P.Qualified mn i, ty) =
Completion
{ complModule = maybe "" P.runModuleName $ P.toMaybeModuleName mn
, complIdentifier = i
, complType = prettyPrintTypeSingleLine ty
, complExpandedType = prettyPrintTypeSingleLine ty
, complLocation = Nothing
, complDocumentation = Nothing
, complExportedFrom = toList $ P.toMaybeModuleName mn
, complDeclarationType = Nothing
}
fieldCompletion (label, ty) =
Completion
{ complModule = ""
, complIdentifier = "_." <> P.prettyPrintLabel label
, complType = prettyPrintTypeSingleLine ty
, complExpandedType = prettyPrintTypeSingleLine ty
, complLocation = Nothing
, complDocumentation = Nothing
, complExportedFrom = []
, complDeclarationType = Nothing
}
textError :: IdeError -> Text
textError (GeneralError msg) = msg
textError (NotFound ident) = "Symbol '" <> ident <> "' not found."
textError (ModuleNotFound ident) = "Module '" <> ident <> "' not found."
textError (ModuleFileNotFound ident) = "Extern file for module " <> ident <>" could not be found"
textError (RebuildError _ err) = show err
prettyPrintTypeSingleLine :: P.Type a -> Text
prettyPrintTypeSingleLine = T.unwords . map T.strip . T.lines . T.pack . P.prettyPrintTypeWithUnicode maxBound