content: -----------------------------------------------------------------------------
  --
  -- 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 path file =
    case snd $ CST.parseFromFile path file of
      Left _ -> Left path
      Right m -> Right (path, m)
  
  parseModulesFromFiles
    :: (MonadIO m, MonadError IdeError m)
    => [FilePath]
    -> m [Either FilePath (FilePath, P.Module)]
  parseModulesFromFiles paths = do
    files <- traverse ideReadFile paths
    pure (inParallel (map (uncurry parseModule) files))
    where
      inParallel :: [Either e (k, a)] -> [Either e (k, a)]
      inParallel = withStrategy (parList rseq)
  
  -- | Extracts AST information from a parsed module
  extractAstInformation
    :: P.Module
    -> (DefinitionSites P.SourceSpan, TypeAnnotations)
  extractAstInformation (P.Module moduleSpan _ mn decls _) =
    let definitions =
          Map.insert
            (IdeNamespaced IdeNSModule (P.runModuleName mn)) moduleSpan
            (Map.fromList (concatMap extractSpans decls))
        typeAnnotations = Map.fromList (extractTypeAnnotations decls)
    in (definitions, typeAnnotations)
  
  -- | Extracts type annotations for functions from a given Module
  extractTypeAnnotations :: [P.Declaration] -> [(P.Ident, P.SourceType)]
  extractTypeAnnotations = mapMaybe (map P.unwrapTypeDeclaration . 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 d = case d of
    P.ValueDecl (ss, _) i _ _ _ ->
      [(IdeNamespaced IdeNSValue (P.runIdent i), ss)]
    P.TypeSynonymDeclaration (ss, _) name _ _ ->
      [(IdeNamespaced IdeNSType (P.runProperName name), ss)]
    P.TypeClassDeclaration (ss, _) name _ _ _ members ->
      (IdeNamespaced IdeNSType (P.runProperName name), ss) : concatMap extractSpans' members
    P.DataDeclaration (ss, _) _ name _ ctors ->
      (IdeNamespaced IdeNSType (P.runProperName name), ss) : map dtorSpan ctors
    P.FixityDeclaration (ss, _) (Left (P.ValueFixity _ _ opName)) ->
      [(IdeNamespaced IdeNSValue (P.runOpName opName), ss)]
    P.FixityDeclaration (ss, _) (Right (P.TypeFixity _ _ opName)) ->
      [(IdeNamespaced IdeNSType (P.runOpName opName), ss)]
    P.ExternDeclaration (ss, _) ident _ ->
      [(IdeNamespaced IdeNSValue (P.runIdent ident), ss)]
    P.ExternDataDeclaration (ss, _) name _ ->
      [(IdeNamespaced IdeNSType (P.runProperName name), ss)]
    _ -> []
    where
      dtorSpan :: P.DataConstructorDeclaration -> (IdeNamespaced, P.SourceSpan)
      dtorSpan P.DataConstructorDeclaration{ P.dataCtorName = name, P.dataCtorAnn = (ss, _) } =
        (IdeNamespaced IdeNSValue (P.runProperName name), 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' dP = case dP of
        P.TypeDeclaration (P.TypeDeclarationData (ss', _) ident _) ->
          [(IdeNamespaced IdeNSValue (P.runIdent ident), ss')]
        _ -> []
  