module Language.PureScript.Ide.SourceFile
( parseModulesFromFiles
, extractAstInformation
, extractSpans
, extractTypeAnnotations
) where
import Protolude
import Control.Parallel.Strategies (withStrategy, parList, rseq)
import qualified Data.Map as Map
import qualified Language.PureScript as P
import qualified Language.PureScript.CST as CST
import Language.PureScript.Ide.Error
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
parseModule :: FilePath -> Text -> Either FilePath (FilePath, P.Module)
parseModule :: FilePath -> Text -> Either FilePath (FilePath, Module)
parseModule FilePath
path Text
file =
case forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ FilePath
-> Text -> ([ParserWarning], Either (NonEmpty ParserError) Module)
CST.parseFromFile FilePath
path Text
file of
Left NonEmpty ParserError
_ -> forall a b. a -> Either a b
Left FilePath
path
Right Module
m -> forall a b. b -> Either a b
Right (FilePath
path, Module
m)
parseModulesFromFiles
:: (MonadIO m, MonadError IdeError m)
=> [FilePath]
-> m [Either FilePath (FilePath, P.Module)]
parseModulesFromFiles :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
[FilePath] -> m [Either FilePath (FilePath, Module)]
parseModulesFromFiles [FilePath]
paths = do
[(FilePath, Text)]
files <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
FilePath -> m (FilePath, Text)
ideReadFile [FilePath]
paths
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall e k a. [Either e (k, a)] -> [Either e (k, a)]
inParallel (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> Text -> Either FilePath (FilePath, Module)
parseModule) [(FilePath, Text)]
files))
where
inParallel :: [Either e (k, a)] -> [Either e (k, a)]
inParallel :: forall e k a. [Either e (k, a)] -> [Either e (k, a)]
inParallel = forall a. Strategy a -> a -> a
withStrategy (forall a. Strategy a -> Strategy [a]
parList forall a. Strategy a
rseq)
extractAstInformation
:: P.Module
-> (DefinitionSites P.SourceSpan, TypeAnnotations)
(P.Module SourceSpan
moduleSpan [Comment]
_ ModuleName
mn [Declaration]
decls Maybe [DeclarationRef]
_) =
let definitions :: DefinitionSites SourceSpan
definitions =
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
(IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSModule (ModuleName -> Text
P.runModuleName ModuleName
mn)) SourceSpan
moduleSpan
(forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Declaration -> [(IdeNamespaced, SourceSpan)]
extractSpans [Declaration]
decls))
typeAnnotations :: TypeAnnotations
typeAnnotations = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Declaration] -> [(Ident, SourceType)]
extractTypeAnnotations [Declaration]
decls)
in (DefinitionSites SourceSpan
definitions, TypeAnnotations
typeAnnotations)
extractTypeAnnotations :: [P.Declaration] -> [(P.Ident, P.SourceType)]
= forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map TypeDeclarationData -> (Ident, SourceType)
P.unwrapTypeDeclaration forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Maybe TypeDeclarationData
P.getTypeDeclaration)
extractSpans
:: P.Declaration
-> [(IdeNamespaced, P.SourceSpan)]
Declaration
d = case Declaration
d of
P.ValueDecl (SourceSpan
ss, [Comment]
_) Ident
i NameKind
_ [Binder]
_ [GuardedExpr]
_ ->
[(IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSValue (Ident -> Text
P.runIdent Ident
i), SourceSpan
ss)]
P.TypeSynonymDeclaration (SourceSpan
ss, [Comment]
_) ProperName 'TypeName
name [(Text, Maybe SourceType)]
_ SourceType
_ ->
[(IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSType (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'TypeName
name), SourceSpan
ss)]
P.TypeClassDeclaration (SourceSpan
ss, [Comment]
_) ProperName 'ClassName
name [(Text, Maybe SourceType)]
_ [SourceConstraint]
_ [FunctionalDependency]
_ [Declaration]
members ->
(IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSType (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'ClassName
name), SourceSpan
ss) forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Declaration -> [(IdeNamespaced, SourceSpan)]
extractSpans' [Declaration]
members
P.DataDeclaration (SourceSpan
ss, [Comment]
_) DataDeclType
_ ProperName 'TypeName
name [(Text, Maybe SourceType)]
_ [DataConstructorDeclaration]
ctors ->
(IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSType (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'TypeName
name), SourceSpan
ss) forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map DataConstructorDeclaration -> (IdeNamespaced, SourceSpan)
dtorSpan [DataConstructorDeclaration]
ctors
P.FixityDeclaration (SourceSpan
ss, [Comment]
_) (Left (P.ValueFixity Fixity
_ Qualified (Either Ident (ProperName 'ConstructorName))
_ OpName 'ValueOpName
opName)) ->
[(IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSValue (forall (a :: OpNameType). OpName a -> Text
P.runOpName OpName 'ValueOpName
opName), SourceSpan
ss)]
P.FixityDeclaration (SourceSpan
ss, [Comment]
_) (Right (P.TypeFixity Fixity
_ Qualified (ProperName 'TypeName)
_ OpName 'TypeOpName
opName)) ->
[(IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSType (forall (a :: OpNameType). OpName a -> Text
P.runOpName OpName 'TypeOpName
opName), SourceSpan
ss)]
P.ExternDeclaration (SourceSpan
ss, [Comment]
_) Ident
ident SourceType
_ ->
[(IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSValue (Ident -> Text
P.runIdent Ident
ident), SourceSpan
ss)]
P.ExternDataDeclaration (SourceSpan
ss, [Comment]
_) ProperName 'TypeName
name SourceType
_ ->
[(IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSType (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'TypeName
name), SourceSpan
ss)]
Declaration
_ -> []
where
dtorSpan :: P.DataConstructorDeclaration -> (IdeNamespaced, P.SourceSpan)
dtorSpan :: DataConstructorDeclaration -> (IdeNamespaced, SourceSpan)
dtorSpan P.DataConstructorDeclaration{ dataCtorName :: DataConstructorDeclaration -> ProperName 'ConstructorName
P.dataCtorName = ProperName 'ConstructorName
name, dataCtorAnn :: DataConstructorDeclaration -> (SourceSpan, [Comment])
P.dataCtorAnn = (SourceSpan
ss, [Comment]
_) } =
(IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSValue (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'ConstructorName
name), SourceSpan
ss)
extractSpans' :: Declaration -> [(IdeNamespaced, SourceSpan)]
extractSpans' Declaration
dP = case Declaration
dP of
P.TypeDeclaration (P.TypeDeclarationData (SourceSpan
ss', [Comment]
_) Ident
ident SourceType
_) ->
[(IdeNamespace -> Text -> IdeNamespaced
IdeNamespaced IdeNamespace
IdeNSValue (Ident -> Text
P.runIdent Ident
ident), SourceSpan
ss')]
Declaration
_ -> []