-----------------------------------------------------------------------------
--
-- Module      : Language.PureScript.Ide.SourceFile
-- Description : Getting declarations from PureScript sourcefiles
-- Copyright   : Christoph Hegemann 2016
-- License     : MIT (http://opensource.org/licenses/MIT)
--
-- Maintainer  : Christoph Hegemann <christoph.hegemann1337@gmail.com>
-- Stability   : experimental
--
-- |
-- Getting declarations from PureScript sourcefiles
-----------------------------------------------------------------------------

module Language.PureScript.Ide.SourceFile
  ( parseModulesFromFiles
  , extractAstInformation
  -- for tests
  , extractSpans
  , extractTypeAnnotations
  ) where

import Protolude

import Control.Parallel.Strategies (withStrategy, parList, rseq)
import Data.Map qualified as Map
import Language.PureScript qualified as P
import Language.PureScript.CST qualified as CST
import Language.PureScript.Ide.Error (IdeError)
import Language.PureScript.Ide.Types (DefinitionSites, IdeNamespace(..), IdeNamespaced(..), TypeAnnotations)
import Language.PureScript.Ide.Util (ideReadFile)

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)

-- | Extracts AST information from a parsed module
extractAstInformation
  :: P.Module
  -> (DefinitionSites P.SourceSpan, TypeAnnotations)
extractAstInformation :: Module -> (DefinitionSites SourceSpan, TypeAnnotations)
extractAstInformation (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)

-- | Extracts type annotations for functions from a given Module
extractTypeAnnotations :: [P.Declaration] -> [(P.Ident, P.SourceType)]
extractTypeAnnotations :: [Declaration] -> [(Ident, SourceType)]
extractTypeAnnotations = 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)

-- | Given a surrounding Sourcespan and a Declaration from the PS AST, extracts
-- definition sites inside that Declaration.
extractSpans
  :: P.Declaration
  -- ^ The declaration to extract spans from
  -> [(IdeNamespaced, P.SourceSpan)]
  -- ^ Declarations and their source locations
extractSpans :: Declaration -> [(IdeNamespaced, SourceSpan)]
extractSpans 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)
    -- We need this special case to be able to also get the position info for
    -- typeclass member functions. Typedeclarations would clash with value
    -- declarations for non-typeclass members, which is why we can't handle them
    -- in extractSpans.
    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
_ -> []