module Language.PureScript.Ide.SourceFile
( parseModule
, 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 Language.PureScript.Ide.Error
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
parseModule
:: (MonadIO m, MonadError IdeError m)
=> FilePath
-> m (Either FilePath (FilePath, P.Module))
parseModule path = do
contents <- ideReadFile path
pure (parseModule' path contents)
parseModule' :: FilePath -> Text -> Either FilePath (FilePath, P.Module)
parseModule' path file =
case P.parseModuleFromFile identity (path, file) of
Left _ -> Left path
Right m -> Right m
parseModulesFromFiles
:: (MonadIO m, MonadError IdeError m)
=> [FilePath]
-> m [Either FilePath (FilePath, P.Module)]
parseModulesFromFiles paths = do
files <- traverse (\p -> (p,) <$> ideReadFile p) paths
pure (inParallel (map (uncurry parseModule') files))
where
inParallel :: [Either e (k, a)] -> [Either e (k, a)]
inParallel = withStrategy (parList rseq)
extractAstInformation
:: P.Module
-> (DefinitionSites P.SourceSpan, TypeAnnotations)
extractAstInformation (P.Module ss _ _ decls _) =
let definitions = Map.fromList (concatMap (extractSpans ss) decls)
typeAnnotations = Map.fromList (extractTypeAnnotations decls)
in (definitions, typeAnnotations)
extractTypeAnnotations
:: [P.Declaration]
-> [(P.Ident, P.Type)]
extractTypeAnnotations = mapMaybe extract
where
extract d = case unwrapPositioned d of
P.TypeDeclaration ident ty -> Just (ident, ty)
_ -> Nothing
extractSpans
:: P.SourceSpan
-> P.Declaration
-> [(IdeNamespaced, P.SourceSpan)]
extractSpans ss d = case d of
P.PositionedDeclaration ss' _ d' ->
extractSpans ss' d'
P.ValueDeclaration i _ _ _ ->
[(IdeNamespaced IdeNSValue (P.runIdent i), ss)]
P.TypeSynonymDeclaration name _ _ ->
[(IdeNamespaced IdeNSType (P.runProperName name), ss)]
P.TypeClassDeclaration name _ _ _ members ->
(IdeNamespaced IdeNSType (P.runProperName name), ss) : concatMap (extractSpans' ss) members
P.DataDeclaration _ name _ ctors ->
(IdeNamespaced IdeNSType (P.runProperName name), ss)
: map (\(cname, _) -> (IdeNamespaced IdeNSValue (P.runProperName cname), ss)) ctors
P.FixityDeclaration (Left (P.ValueFixity _ _ opName)) ->
[(IdeNamespaced IdeNSValue (P.runOpName opName), ss)]
P.FixityDeclaration (Right (P.TypeFixity _ _ opName)) ->
[(IdeNamespaced IdeNSType (P.runOpName opName), ss)]
P.ExternDeclaration ident _ ->
[(IdeNamespaced IdeNSValue (P.runIdent ident), ss)]
P.ExternDataDeclaration name _ ->
[(IdeNamespaced IdeNSType (P.runProperName name), ss)]
P.ExternKindDeclaration name ->
[(IdeNamespaced IdeNSKind (P.runProperName name), ss)]
_ -> []
where
extractSpans' ssP dP = case dP of
P.PositionedDeclaration ssP' _ dP' ->
extractSpans' ssP' dP'
P.TypeDeclaration ident _ ->
[(IdeNamespaced IdeNSValue (P.runIdent ident), ssP)]
_ -> []