module Language.PureScript.Ide.SourceFile
( parseModule
, extractAstInformation
, extractSpans
, extractTypeAnnotations
) where
import Protolude
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
import System.Directory (getCurrentDirectory)
import System.FilePath (makeRelative)
parseModule
:: (MonadIO m, MonadError IdeError m)
=> FilePath
-> m (Either FilePath (FilePath, P.Module))
parseModule path = do
pwd <- liftIO getCurrentDirectory
contents <- ideReadFile path
case P.parseModuleFromFile (makeRelative pwd) (path, contents) of
Left _ -> pure (Left path)
Right m -> pure (Right m)
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
-> [(IdeDeclNamespace, P.SourceSpan)]
extractSpans ss d = case d of
P.PositionedDeclaration ss' _ d' ->
extractSpans ss' d'
P.ValueDeclaration i _ _ _ ->
[(IdeNSValue (P.runIdent i), ss)]
P.TypeSynonymDeclaration name _ _ ->
[(IdeNSType (P.runProperName name), ss)]
P.TypeClassDeclaration name _ _ _ members ->
(IdeNSType (P.runProperName name), ss) : concatMap (extractSpans' ss) members
P.DataDeclaration _ name _ ctors ->
(IdeNSType (P.runProperName name), ss)
: map (\(cname, _) -> (IdeNSValue (P.runProperName cname), ss)) ctors
P.FixityDeclaration (Left (P.ValueFixity _ _ opName)) ->
[(IdeNSValue (P.runOpName opName), ss)]
P.FixityDeclaration (Right (P.TypeFixity _ _ opName)) ->
[(IdeNSType (P.runOpName opName), ss)]
P.ExternDeclaration ident _ ->
[(IdeNSValue (P.runIdent ident), ss)]
P.ExternDataDeclaration name _ ->
[(IdeNSType (P.runProperName name), ss)]
P.ExternKindDeclaration name ->
[(IdeNSKind (P.runProperName name), ss)]
_ -> []
where
extractSpans' ssP dP = case dP of
P.PositionedDeclaration ssP' _ dP' ->
extractSpans' ssP' dP'
P.TypeDeclaration ident _ ->
[(IdeNSValue (P.runIdent ident), ssP)]
_ -> []