-----------------------------------------------------------------------------
--
-- 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 (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