module Language.PureScript.Ide.Types where
import Prelude ()
import Prelude.Compat
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.Reader.Class
import Control.Monad.Trans
import Data.Aeson
import Data.Map.Lazy as M
import Data.Maybe (maybeToList)
import Data.Text (Text (), pack, unpack)
import qualified Language.PureScript.AST.Declarations as D
import Language.PureScript.Externs
import qualified Language.PureScript.Errors.JSON as P
import qualified Language.PureScript.Names as N
import qualified Language.PureScript as P
import Text.Parsec
import Text.Parsec.Text
type Ident = Text
type DeclIdent = Text
type ModuleIdent = Text
data ExternDecl
= ValueDeclaration Ident P.Type
| TypeDeclaration (P.ProperName 'P.TypeName) P.Kind
| TypeSynonymDeclaration (P.ProperName 'P.TypeName) P.Type
| Dependency
ModuleIdent
[Text]
(Maybe Text)
| ModuleDecl
ModuleIdent
[DeclIdent]
| DataConstructor
DeclIdent
(P.ProperName 'P.TypeName)
P.Type
| TypeClassDeclaration (P.ProperName 'P.ClassName)
| ValueOperator (P.OpName 'P.ValueOpName) Ident P.Precedence P.Associativity
| TypeOperator (P.OpName 'P.TypeOpName) Ident P.Precedence P.Associativity
| Export ModuleIdent
deriving (Show,Eq,Ord)
type Module = (ModuleIdent, [ExternDecl])
data Configuration =
Configuration
{ confOutputPath :: FilePath
, confDebug :: Bool
}
data PscIdeEnvironment =
PscIdeEnvironment
{ envStateVar :: TVar PscIdeState
, envConfiguration :: Configuration
}
type PscIde m = (MonadIO m, MonadReader PscIdeEnvironment m)
data PscIdeState =
PscIdeState
{ pscIdeStateModules :: M.Map Text [ExternDecl]
, pscIdeStateExternsFiles :: M.Map P.ModuleName ExternsFile
, pscIdeStateCachedRebuild :: Maybe (P.ModuleName, ExternsFile)
} deriving Show
emptyPscIdeState :: PscIdeState
emptyPscIdeState = PscIdeState M.empty M.empty Nothing
data Match = Match ModuleIdent ExternDecl
deriving (Show, Eq)
newtype Completion =
Completion (ModuleIdent, DeclIdent, Text)
deriving (Show,Eq)
instance ToJSON Completion where
toJSON (Completion (m,d,t)) =
object ["module" .= m, "identifier" .= d, "type" .= t]
data ModuleImport =
ModuleImport
{ importModuleName :: ModuleIdent
, importType :: D.ImportDeclarationType
, importQualifier :: Maybe Text
} deriving(Show)
instance Eq ModuleImport where
mi1 == mi2 =
importModuleName mi1 == importModuleName mi2
&& importQualifier mi1 == importQualifier mi2
instance ToJSON ModuleImport where
toJSON (ModuleImport mn D.Implicit qualifier) =
object $ [ "module" .= mn
, "importType" .= ("implicit" :: Text)
] ++ fmap (\x -> "qualifier" .= x) (maybeToList qualifier)
toJSON (ModuleImport mn (D.Explicit refs) _) =
object [ "module" .= mn
, "importType" .= ("explicit" :: Text)
, "identifiers" .= (identifierFromDeclarationRef <$> refs)
]
toJSON (ModuleImport mn (D.Hiding refs) _) =
object [ "module" .= mn
, "importType" .= ("hiding" :: Text)
, "identifiers" .= (identifierFromDeclarationRef <$> refs)
]
identifierFromDeclarationRef :: D.DeclarationRef -> String
identifierFromDeclarationRef (D.TypeRef name _) = N.runProperName name
identifierFromDeclarationRef (D.ValueRef ident) = N.runIdent ident
identifierFromDeclarationRef (D.TypeClassRef name) = N.runProperName name
identifierFromDeclarationRef _ = ""
data Success =
CompletionResult [Completion]
| TextResult Text
| MultilineTextResult [Text]
| PursuitResult [PursuitResponse]
| ImportList [ModuleImport]
| ModuleList [ModuleIdent]
| RebuildSuccess [P.JSONError]
deriving(Show, Eq)
encodeSuccess :: (ToJSON a) => a -> Value
encodeSuccess res =
object ["resultType" .= ("success" :: Text), "result" .= res]
instance ToJSON Success where
toJSON (CompletionResult cs) = encodeSuccess cs
toJSON (TextResult t) = encodeSuccess t
toJSON (MultilineTextResult ts) = encodeSuccess ts
toJSON (PursuitResult resp) = encodeSuccess resp
toJSON (ImportList decls) = encodeSuccess decls
toJSON (ModuleList modules) = encodeSuccess modules
toJSON (RebuildSuccess modules) = encodeSuccess modules
newtype PursuitQuery = PursuitQuery Text
deriving (Show, Eq)
data PursuitSearchType = Package | Identifier
deriving (Show, Eq)
instance FromJSON PursuitSearchType where
parseJSON (String t) = case t of
"package" -> pure Package
"completion" -> pure Identifier
_ -> mzero
parseJSON _ = mzero
instance FromJSON PursuitQuery where
parseJSON o = PursuitQuery <$> parseJSON o
data PursuitResponse =
ModuleResponse ModuleIdent Text
| DeclarationResponse Text ModuleIdent DeclIdent Text
deriving (Show,Eq)
instance FromJSON PursuitResponse where
parseJSON (Object o) = do
package <- o .: "package"
info <- o .: "info"
(type' :: String) <- info .: "type"
case type' of
"module" -> do
name <- info .: "module"
pure (ModuleResponse name package)
"declaration" -> do
moduleName <- info .: "module"
Right (ident, declType) <- typeParse <$> o .: "text"
pure (DeclarationResponse declType moduleName ident package)
_ -> mzero
parseJSON _ = mzero
typeParse :: Text -> Either Text (Text, Text)
typeParse t = case parse parseType "" t of
Right (x,y) -> Right (pack x, pack y)
Left err -> Left (pack (show err))
where
parseType :: Parser (String, String)
parseType = do
name <- identifier
_ <- string "::"
spaces
type' <- many1 anyChar
pure (unpack name, type')
identifier :: Parser Text
identifier = do
spaces
ident <-
between (char '(') (char ')') (many1 (noneOf ", )")) <|>
many1 (noneOf ", )")
spaces
pure (pack ident)
instance ToJSON PursuitResponse where
toJSON (ModuleResponse name package) =
object ["module" .= name, "package" .= package]
toJSON (DeclarationResponse module' ident type' package) =
object
[ "module" .= module'
, "ident" .= ident
, "type" .= type'
, "package" .= package
]