module Language.PureScript.Ide.SourceFile
( parseModule
, getImportsForFile
, extractSpans
) where
import Protolude
import qualified Language.PureScript as P
import Language.PureScript.Ide.Error
import Language.PureScript.Ide.Util
import Language.PureScript.Ide.Types
import System.IO.UTF8 (readUTF8File)
parseModule
:: (MonadIO m)
=> FilePath
-> m (Either FilePath (FilePath, P.Module) )
parseModule path = do
contents <- liftIO (readUTF8File path)
case P.parseModuleFromFile identity (path, contents) of
Left _ -> pure (Left path)
Right m -> pure (Right m)
getImports :: P.Module -> [(P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)]
getImports (P.Module _ _ _ declarations _) =
mapMaybe isImport declarations
where
isImport (P.PositionedDeclaration _ _ (P.ImportDeclaration a b c)) = Just (a, b, c)
isImport _ = Nothing
getImportsForFile :: (MonadIO m, MonadError PscIdeError m) =>
FilePath -> m [ModuleImport]
getImportsForFile fp = do
moduleE <- parseModule fp
case moduleE of
Left _ -> throwError (GeneralError "Failed to parse sourcefile.")
Right (_, module') ->
pure (mkModuleImport . unwrapPositionedImport <$> getImports module')
where
mkModuleImport (mn, importType', qualifier) =
ModuleImport
(runModuleNameT mn)
importType'
(runModuleNameT <$> qualifier)
unwrapPositionedImport (mn, it, q) = (mn, unwrapImportType it, q)
unwrapImportType (P.Explicit decls) = P.Explicit (map unwrapPositionedRef decls)
unwrapImportType (P.Hiding decls) = P.Hiding (map unwrapPositionedRef decls)
unwrapImportType P.Implicit = P.Implicit
extractSpans
:: P.SourceSpan
-> P.Declaration
-> [(Either Text Text, P.SourceSpan)]
extractSpans ss d = case d of
P.PositionedDeclaration ss' _ d' ->
extractSpans ss' d'
P.ValueDeclaration i _ _ _ ->
[(Left (runIdentT i), ss)]
P.TypeSynonymDeclaration name _ _ ->
[(Right (runProperNameT name), ss)]
P.TypeClassDeclaration name _ _ members ->
(Right (runProperNameT name), ss) : concatMap (extractSpans' ss) members
P.DataDeclaration _ name _ ctors ->
(Right (runProperNameT name), ss)
: map (\(cname, _) -> (Left (runProperNameT cname), ss)) ctors
P.ExternDeclaration ident _ ->
[(Left (runIdentT ident), ss)]
P.ExternDataDeclaration name _ ->
[(Right (runProperNameT name), ss)]
_ -> []
where
extractSpans' ssP dP = case dP of
P.PositionedDeclaration ssP' _ dP' ->
extractSpans' ssP' dP'
P.TypeDeclaration ident _ ->
[(Left (runIdentT ident), ssP)]
_ -> []