{-# Language DataKinds, FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, OverloadedStrings,
             ScopedTypeVariables, StandaloneDeriving,
             TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}

-- | The programming language Haskell

module Language.Haskell (parseModule, predefinedModuleBindings, preludeBindings, resolvePositions, Input,
                         -- * Node wrappers
                         -- | An abstract syntax tree produced by this library contains nodes of different types
                         -- (declarations, types, expressions, patterns, etc), but every node is contained by the
                         -- same type of /wrapper/ node.
                         Parsed, Placed, Bound) where

import qualified Language.Haskell.Abstract as Abstract
import qualified Language.Haskell.Binder as Binder
import Language.Haskell.Extensions as Extensions (Extension, includedByDefault)
import qualified Language.Haskell.Extensions.AST as AST
import qualified Language.Haskell.Extensions.Grammar as Grammar
import qualified Language.Haskell.Extensions.Verifier as Verifier
import qualified Language.Haskell.Reorganizer as Reorganizer
import qualified Language.Haskell.Reserializer as Reserializer

import qualified Rank2
import qualified Transformation
import qualified Transformation.Deep as Deep
import qualified Transformation.Full as Full
import qualified Transformation.Rank2 as Rank2
import qualified Transformation.AG.Dimorphic as Di

import Control.Monad ((>=>))
import Data.Either.Validation (validationToEither)
import Data.Functor.Compose (Compose(..))
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid.Instances.PrefixMemory (Shadowed, content)
import Data.Monoid.Textual (fromText)
import Data.Ord (Down)
import Data.Semigroup.Union (UnionWith(..))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import System.Directory (listDirectory)
import System.FilePath.Posix (combine)
import System.IO.Unsafe (unsafeInterleaveIO)
import Text.Grampa (ParseResults, ParseFailure (errorAlternatives))
import Text.Parser.Input.Position (offset)

import Paths_language_haskell (getDataDir)

import Prelude hiding (readFile)

-- | Every node in a parsed AST is originally wrapped with this functor
type Parsed = Grammar.NodeWrap Input

-- | Every node in a parsed AST with calculated positions is wrapped with this functor
type Placed = Reserializer.Wrapped Int Text

-- | Every node in a parsed and resolved AST is wrapped with this functor
type Bound = Binder.WithEnvironment AST.Language Placed

-- | The input monoid type
type Input = Shadowed Text

-- | Parse the given text of a single module according to the specified language extensions and resolve all
-- identifiers inside the module.
parseModule :: Map Extension Bool                      -- ^ language extension switches
            -> Binder.ModuleEnvironment AST.Language   -- ^ modules available for import
            -> Binder.Environment AST.Language         -- ^ names available without import
            -> Bool                                    -- ^ verify if the identifiers are bound and extensions used?
            -> Text                                    -- ^ the module's source code
            -> ParseResults Input [Bound (AST.Module AST.Language AST.Language Bound Bound)]
parseModule :: Map Extension Bool
-> ModuleEnvironment Language
-> Environment Language
-> Bool
-> Text
-> ParseResults
     Input [Bound (Module Language Language Bound Bound)]
parseModule Map Extension Bool
extensions ModuleEnvironment Language
modEnv Environment Language
env Bool
verify Text
source =
   ((Map Extension Bool
-> ModuleEnvironment Language
-> Environment Language
-> Text
-> Parsed (Module Language Language Parsed Parsed)
-> Bound (Module Language Language Bound Bound)
forall (node :: (* -> *) -> (* -> *) -> *).
(Traversable (Keep (Binder Language Parsed)) node,
 Traversable (Reorganization Language Pos Input) node,
 Functor
   (Mapped ((,) (Attributes Language)) (Map Parsed Placed)) node) =>
Map Extension Bool
-> ModuleEnvironment Language
-> Environment Language
-> Text
-> Parsed (node Parsed Parsed)
-> Bound (node Bound Bound)
resolvePositions Map Extension Bool
extensions ModuleEnvironment Language
modEnv Environment Language
env Text
source (Parsed (Module Language Language Parsed Parsed)
 -> Bound (Module Language Language Bound Bound))
-> [Parsed (Module Language Language Parsed Parsed)]
-> [Bound (Module Language Language Bound Bound)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
    ([Parsed (Module Language Language Parsed Parsed)]
 -> [Bound (Module Language Language Bound Bound)])
-> Either
     (ParseFailure Pos Input)
     [Parsed (Module Language Language Parsed Parsed)]
-> ParseResults
     Input [Bound (Module Language Language Bound Bound)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Extension Bool
-> Input
-> ParseResults
     Input [NodeWrap Input (Module Language Language Parsed Parsed)]
forall l t.
(ExtendedHaskell l,
 LexicalParsing (Parser (ExtendedGrammar l t (NodeWrap t)) t),
 Ord t, Show t, OutlineMonoid t, SpaceMonoid t,
 DeeplyFoldable (Serialization Pos t) l) =>
Map Extension Bool
-> t
-> ParseResults
     t [NodeWrap t (Module l l (NodeWrap t) (NodeWrap t))]
Grammar.parseModule Map Extension Bool
extensions (Text -> Input
forall t. TextualMonoid t => Text -> t
fromText Text
source :: Input))
   ParseResults Input [Bound (Module Language Language Bound Bound)]
-> ([Bound (Module Language Language Bound Bound)]
    -> ParseResults
         Input [Bound (Module Language Language Bound Bound)])
-> ParseResults
     Input [Bound (Module Language Language Bound Bound)]
forall a b.
Either (ParseFailure Pos Input) a
-> (a -> Either (ParseFailure Pos Input) b)
-> Either (ParseFailure Pos Input) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (if Bool
verify then (Bound (Module Language Language Bound Bound)
 -> Either
      (ParseFailure Pos Input)
      (Bound (Module Language Language Bound Bound)))
-> [Bound (Module Language Language Bound Bound)]
-> ParseResults
     Input [Bound (Module Language Language Bound Bound)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Bound (Module Language Language Bound Bound)
-> Either
     (ParseFailure Pos Input)
     (Bound (Module Language Language Bound Bound))
checkAllBound (Bound (Module Language Language Bound Bound)
 -> Either
      (ParseFailure Pos Input)
      (Bound (Module Language Language Bound Bound)))
-> (Bound (Module Language Language Bound Bound)
    -> Either
         (ParseFailure Pos Input)
         (Bound (Module Language Language Bound Bound)))
-> Bound (Module Language Language Bound Bound)
-> Either
     (ParseFailure Pos Input)
     (Bound (Module Language Language Bound Bound))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Map Extension Bool
-> Bound (Module Language Language Bound Bound)
-> Either
     (ParseFailure Pos Input)
     (Bound (Module Language Language Bound Bound))
checkRestrictions Map Extension Bool
extensions) else [Bound (Module Language Language Bound Bound)]
-> ParseResults
     Input [Bound (Module Language Language Bound Bound)]
forall a. a -> Either (ParseFailure Pos Input) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

-- | Resolve identifiers in the given parsed AST, and replace the stored positions in the entire tree with
-- offsets from the start of the given source text.
resolvePositions :: (Full.Traversable (Di.Keep (Binder.Binder AST.Language Parsed)) node,
                     Full.Traversable (Reorganizer.Reorganization AST.Language (Down Int) Input) node,
                     Deep.Functor
                        (Transformation.Mapped
                            ((,) (Binder.Attributes AST.Language))
                            (Rank2.Map Parsed Placed))
                        node)
                 => Map Extension Bool                      -- ^ language extension switches
                 -> Binder.ModuleEnvironment AST.Language   -- ^ modules available for import
                 -> Binder.Environment AST.Language         -- ^ names available without import
                 -> Text                                    -- ^ the module's source code for adjusting node positions
                 -> Parsed (node Parsed Parsed)             -- ^ parsed AST
                 -> Bound (node Bound Bound)
resolvePositions :: forall (node :: (* -> *) -> (* -> *) -> *).
(Traversable (Keep (Binder Language Parsed)) node,
 Traversable (Reorganization Language Pos Input) node,
 Functor
   (Mapped ((,) (Attributes Language)) (Map Parsed Placed)) node) =>
Map Extension Bool
-> ModuleEnvironment Language
-> Environment Language
-> Text
-> Parsed (node Parsed Parsed)
-> Bound (node Bound Bound)
resolvePositions Map Extension Bool
extensions ModuleEnvironment Language
modEnv Environment Language
env Text
src =
   (Map Parsed Placed
-> Mapped ((,) (Attributes Language)) (Map Parsed Placed)
forall (f :: * -> *) t. t -> Mapped f t
Transformation.Mapped ((forall x. Wrapped Pos Input x -> Placed x) -> Map Parsed Placed
forall (p :: * -> *) (q :: * -> *).
(forall x. p x -> q x) -> Map p q
Rank2.Map Wrapped Pos Input x -> Wrapped Int Text x
forall x. Wrapped Pos Input x -> Placed x
rewrap) Mapped ((,) (Attributes Language)) (Map Parsed Placed)
-> Domain
     (Mapped ((,) (Attributes Language)) (Map Parsed Placed))
     (node
        (Domain (Mapped ((,) (Attributes Language)) (Map Parsed Placed)))
        (Domain (Mapped ((,) (Attributes Language)) (Map Parsed Placed))))
-> Codomain
     (Mapped ((,) (Attributes Language)) (Map Parsed Placed))
     (node
        (Codomain (Mapped ((,) (Attributes Language)) (Map Parsed Placed)))
        (Codomain
           (Mapped ((,) (Attributes Language)) (Map Parsed Placed))))
forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t
-> Domain t (g (Domain t) (Domain t))
-> Codomain t (g (Codomain t) (Codomain t))
Full.<$>)
   (Compose
   ((,) (Attributes Language))
   Parsed
   (node (Wrap Language Pos Input) (Wrap Language Pos Input))
 -> Compose ((,) (Attributes Language)) Placed (node Bound Bound))
-> (Parsed (node Parsed Parsed)
    -> Compose
         ((,) (Attributes Language))
         Parsed
         (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
-> Parsed (node Parsed Parsed)
-> Compose ((,) (Attributes Language)) Placed (node Bound Bound)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (Error Language (Wrap Language Pos Input))
 -> Compose
      ((,) (Attributes Language))
      Parsed
      (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
-> (Compose
      ((,) (Attributes Language))
      Parsed
      (node (Wrap Language Pos Input) (Wrap Language Pos Input))
    -> Compose
         ((,) (Attributes Language))
         Parsed
         (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
-> Either
     (NonEmpty (Error Language (Wrap Language Pos Input)))
     (Compose
        ((,) (Attributes Language))
        Parsed
        (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
-> Compose
     ((,) (Attributes Language))
     Parsed
     (node (Wrap Language Pos Input) (Wrap Language Pos Input))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath
-> Compose
     ((,) (Attributes Language))
     Parsed
     (node (Wrap Language Pos Input) (Wrap Language Pos Input))
forall a. HasCallStack => FilePath -> a
error (FilePath
 -> Compose
      ((,) (Attributes Language))
      Parsed
      (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
-> (NonEmpty (Error Language (Wrap Language Pos Input))
    -> FilePath)
-> NonEmpty (Error Language (Wrap Language Pos Input))
-> Compose
     ((,) (Attributes Language))
     Parsed
     (node (Wrap Language Pos Input) (Wrap Language Pos Input))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Error Language (Wrap Language Pos Input)) -> FilePath
forall a. Show a => a -> FilePath
show) Compose
  ((,) (Attributes Language))
  Parsed
  (node (Wrap Language Pos Input) (Wrap Language Pos Input))
-> Compose
     ((,) (Attributes Language))
     Parsed
     (node (Wrap Language Pos Input) (Wrap Language Pos Input))
forall a. a -> a
id (Either
   (NonEmpty (Error Language (Wrap Language Pos Input)))
   (Compose
      ((,) (Attributes Language))
      Parsed
      (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
 -> Compose
      ((,) (Attributes Language))
      Parsed
      (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
-> (Parsed (node Parsed Parsed)
    -> Either
         (NonEmpty (Error Language (Wrap Language Pos Input)))
         (Compose
            ((,) (Attributes Language))
            Parsed
            (node (Wrap Language Pos Input) (Wrap Language Pos Input))))
-> Parsed (node Parsed Parsed)
-> Compose
     ((,) (Attributes Language))
     Parsed
     (node (Wrap Language Pos Input) (Wrap Language Pos Input))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation
  (NonEmpty (Error Language (Wrap Language Pos Input)))
  (Compose
     ((,) (Attributes Language))
     Parsed
     (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
-> Either
     (NonEmpty (Error Language (Wrap Language Pos Input)))
     (Compose
        ((,) (Attributes Language))
        Parsed
        (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
forall e a. Validation e a -> Either e a
validationToEither
   (Validation
   (NonEmpty (Error Language (Wrap Language Pos Input)))
   (Compose
      ((,) (Attributes Language))
      Parsed
      (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
 -> Either
      (NonEmpty (Error Language (Wrap Language Pos Input)))
      (Compose
         ((,) (Attributes Language))
         Parsed
         (node (Wrap Language Pos Input) (Wrap Language Pos Input))))
-> (Parsed (node Parsed Parsed)
    -> Validation
         (NonEmpty (Error Language (Wrap Language Pos Input)))
         (Compose
            ((,) (Attributes Language))
            Parsed
            (node (Wrap Language Pos Input) (Wrap Language Pos Input))))
-> Parsed (node Parsed Parsed)
-> Either
     (NonEmpty (Error Language (Wrap Language Pos Input)))
     (Compose
        ((,) (Attributes Language))
        Parsed
        (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reorganization Language Pos Input
-> Domain
     (Reorganization Language Pos Input)
     (node
        (Domain (Reorganization Language Pos Input))
        (Domain (Reorganization Language Pos Input)))
-> Validation
     (NonEmpty (Error Language (Wrap Language Pos Input)))
     (Compose
        ((,) (Attributes Language))
        Parsed
        (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
forall t (g :: (* -> *) -> (* -> *) -> *) (m :: * -> *)
       (f :: * -> *).
(Traversable t g, Codomain t ~ Compose m f) =>
t -> Domain t (g (Domain t) (Domain t)) -> m (f (g f f))
forall (m :: * -> *) (f :: * -> *).
(Codomain (Reorganization Language Pos Input) ~ Compose m f) =>
Reorganization Language Pos Input
-> Domain
     (Reorganization Language Pos Input)
     (node
        (Domain (Reorganization Language Pos Input))
        (Domain (Reorganization Language Pos Input)))
-> m (f (node f f))
Full.traverse Reorganization Language Pos Input
forall l pos s. Reorganization l pos s
Reorganizer.Reorganization
   (Compose
   ((,) (Attributes Language))
   Parsed
   (node (Wrap Language Pos Input) (Wrap Language Pos Input))
 -> Validation
      (NonEmpty (Error Language (Wrap Language Pos Input)))
      (Compose
         ((,) (Attributes Language))
         Parsed
         (node (Wrap Language Pos Input) (Wrap Language Pos Input))))
-> (Parsed (node Parsed Parsed)
    -> Compose
         ((,) (Attributes Language))
         Parsed
         (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
-> Parsed (node Parsed Parsed)
-> Validation
     (NonEmpty (Error Language (Wrap Language Pos Input)))
     (Compose
        ((,) (Attributes Language))
        Parsed
        (node (Wrap Language Pos Input) (Wrap Language Pos Input)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Extension Bool
-> ModuleEnvironment Language
-> Environment Language
-> Parsed (node Parsed Parsed)
-> Compose
     ((,) (Attributes Language))
     Parsed
     (node (Wrap Language Pos Input) (Wrap Language Pos Input))
forall l (p :: * -> *) (g :: (* -> *) -> (* -> *) -> *)
       (q :: * -> *).
(Traversable (Keep (Binder l p)) g, q ~ WithEnvironment l p) =>
Map Extension Bool
-> ModuleEnvironment l -> Environment l -> p (g p p) -> q (g q q)
Binder.withBindings Map Extension Bool
extensions ModuleEnvironment Language
modEnv Environment Language
env
   where rewrap :: forall a. Reserializer.Wrapped (Down Int) Input a -> Reserializer.Wrapped Int Text a
         rewrap :: forall x. Wrapped Pos Input x -> Placed x
rewrap = (Pos -> Int)
-> (Input -> Text) -> Wrapped Pos Input a -> Wrapped Int Text a
forall pos pos' s s' a.
(pos -> pos') -> (s -> s') -> Wrapped pos s a -> Wrapped pos' s' a
Reserializer.mapWrapping (Text -> Pos -> Int
forall p s. (Position p, FactorialMonoid s) => s -> p -> Int
forall s. FactorialMonoid s => s -> Pos -> Int
offset Text
src) Input -> Text
forall m. Shadowed m -> m
content

-- | Check if all the identifiers in the given resolved module are properly bound.
checkAllBound :: Bound (AST.Module AST.Language AST.Language Bound Bound)
              -> ParseResults Input (Bound (AST.Module AST.Language AST.Language Bound Bound))
checkAllBound :: Bound (Module Language Language Bound Bound)
-> Either
     (ParseFailure Pos Input)
     (Bound (Module Language Language Bound Bound))
checkAllBound Bound (Module Language Language Bound Bound)
m = if Unbound Language
unbounds Unbound Language -> Unbound Language -> Bool
forall a. Eq a => a -> a -> Bool
== Unbound Language
forall a. Monoid a => a
mempty then Bound (Module Language Language Bound Bound)
-> Either
     (ParseFailure Pos Input)
     (Bound (Module Language Language Bound Bound))
forall a. a -> Either (ParseFailure Pos Input) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bound (Module Language Language Bound Bound)
m
                  else ParseFailure Pos Input
-> Either
     (ParseFailure Pos Input)
     (Bound (Module Language Language Bound Bound))
forall a b. a -> Either a b
Left ParseFailure Pos Input
forall a. Monoid a => a
mempty{errorAlternatives= [show unbounds]}
   where unbounds :: Unbound Language
unbounds = Bound (Module Language Language Bound Bound) -> Unbound Language
forall l (p :: * -> *) (g :: (* -> *) -> (* -> *) -> *).
Foldable (BindingVerifier l p) g =>
WithEnvironment l p (g (WithEnvironment l p) (WithEnvironment l p))
-> Unbound l
Binder.unboundNames Bound (Module Language Language Bound Bound)
m

-- | Check if the given resolved module conforms to and depends on the given extensions.
checkRestrictions :: Map Extension Bool
                  -> Bound (AST.Module AST.Language AST.Language Bound Bound)
                  -> ParseResults Input (Bound (AST.Module AST.Language AST.Language Bound Bound))
checkRestrictions :: Map Extension Bool
-> Bound (Module Language Language Bound Bound)
-> Either
     (ParseFailure Pos Input)
     (Bound (Module Language Language Bound Bound))
checkRestrictions Map Extension Bool
extensions Bound (Module Language Language Bound Bound)
m = case Map Extension Bool
-> Bound (Module Language Language Bound Bound) -> [Error Int]
forall (w :: * -> *) l pos s (g :: (* -> *) -> (* -> *) -> *).
(w ~ Wrap l pos s, Foldable (Verification l pos s) g) =>
Map Extension Bool -> w (g w w) -> [Error pos]
Verifier.verify Map Extension Bool
extensions Bound (Module Language Language Bound Bound)
m of
   [] -> Bound (Module Language Language Bound Bound)
-> Either
     (ParseFailure Pos Input)
     (Bound (Module Language Language Bound Bound))
forall a. a -> Either (ParseFailure Pos Input) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bound (Module Language Language Bound Bound)
m
   [Error Int]
errors -> ParseFailure Pos Input
-> Either
     (ParseFailure Pos Input)
     (Bound (Module Language Language Bound Bound))
forall a b. a -> Either a b
Left ParseFailure Pos Input
forall a. Monoid a => a
mempty{errorAlternatives= show <$> errors}

instance (Rank2.Functor (g (Compose ((,) (Binder.Attributes AST.Language)) q)),
          Deep.Functor (Transformation.Mapped ((,) (Binder.Attributes AST.Language)) (Rank2.Map q Placed)) g) =>
         Full.Functor (Transformation.Mapped ((,) (Binder.Attributes AST.Language)) (Rank2.Map q Placed)) g where
   <$> :: Mapped ((,) (Attributes Language)) (Map q Placed)
-> Domain
     (Mapped ((,) (Attributes Language)) (Map q Placed))
     (g (Domain (Mapped ((,) (Attributes Language)) (Map q Placed)))
        (Domain (Mapped ((,) (Attributes Language)) (Map q Placed))))
-> Codomain
     (Mapped ((,) (Attributes Language)) (Map q Placed))
     (g (Codomain (Mapped ((,) (Attributes Language)) (Map q Placed)))
        (Codomain (Mapped ((,) (Attributes Language)) (Map q Placed))))
(<$>) = Mapped ((,) (Attributes Language)) (Map q Placed)
-> Domain
     (Mapped ((,) (Attributes Language)) (Map q Placed))
     (g (Domain (Mapped ((,) (Attributes Language)) (Map q Placed)))
        (Domain (Mapped ((,) (Attributes Language)) (Map q Placed))))
-> Codomain
     (Mapped ((,) (Attributes Language)) (Map q Placed))
     (g (Codomain (Mapped ((,) (Attributes Language)) (Map q Placed)))
        (Codomain (Mapped ((,) (Attributes Language)) (Map q Placed))))
forall t (g :: (* -> *) -> (* -> *) -> *).
(Functor t g, At t (g (Domain t) (Domain t)),
 Functor (Codomain t)) =>
t
-> Domain t (g (Domain t) (Domain t))
-> Codomain t (g (Codomain t) (Codomain t))
Full.mapDownDefault

-- | All the qualified bindings available without any import statement, such as @Prelude.id@
predefinedModuleBindings :: IO (Binder.ModuleEnvironment AST.Language)
predefinedModuleBindings :: IO (ModuleEnvironment Language)
predefinedModuleBindings = Map (ModuleName Language) (LocalEnvironment Language)
-> ModuleEnvironment Language
forall (f :: * -> *) m. f m -> UnionWith f m
UnionWith (Map (ModuleName Language) (LocalEnvironment Language)
 -> ModuleEnvironment Language)
-> (LocalEnvironment Language
    -> Map (ModuleName Language) (LocalEnvironment Language))
-> LocalEnvironment Language
-> ModuleEnvironment Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ModuleName Language, LocalEnvironment Language)]
-> Map (ModuleName Language) (LocalEnvironment Language)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ModuleName Language, LocalEnvironment Language)]
 -> Map (ModuleName Language) (LocalEnvironment Language))
-> (LocalEnvironment Language
    -> [(ModuleName Language, LocalEnvironment Language)])
-> LocalEnvironment Language
-> Map (ModuleName Language) (LocalEnvironment Language)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName Language, LocalEnvironment Language)
-> [(ModuleName Language, LocalEnvironment Language)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ModuleName Language, LocalEnvironment Language)
 -> [(ModuleName Language, LocalEnvironment Language)])
-> (LocalEnvironment Language
    -> (ModuleName Language, LocalEnvironment Language))
-> LocalEnvironment Language
-> [(ModuleName Language, LocalEnvironment Language)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) ModuleName Language
ModuleName Language
forall l. Haskell l => ModuleName l
Binder.preludeName (LocalEnvironment Language -> ModuleEnvironment Language)
-> IO (LocalEnvironment Language)
-> IO (ModuleEnvironment Language)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (LocalEnvironment Language)
unqualifiedPreludeBindings

-- | All the @Prelude@ bindings available without any import statement
preludeBindings :: IO (Binder.Environment AST.Language)
preludeBindings :: IO (Environment Language)
preludeBindings = (Map (Name Language) (Binding Language)
 -> Map (QualifiedName Language) (Binding Language))
-> LocalEnvironment Language -> Environment Language
forall j a k b.
(Map j a -> Map k b) -> UnionWith (Map j) a -> UnionWith (Map k) b
Binder.onMap ((Name Language -> QualifiedName Language)
-> Map (Name Language) (Binding Language)
-> Map (QualifiedName Language) (Binding Language)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic ((Name Language -> QualifiedName Language)
 -> Map (Name Language) (Binding Language)
 -> Map (QualifiedName Language) (Binding Language))
-> (Name Language -> QualifiedName Language)
-> Map (Name Language) (Binding Language)
-> Map (QualifiedName Language) (Binding Language)
forall a b. (a -> b) -> a -> b
$ Maybe (ModuleName Language)
-> Name Language -> QualifiedName Language
forall λ.
Haskell λ =>
Maybe (ModuleName λ) -> Name λ -> QualifiedName λ
Abstract.qualifiedName Maybe (ModuleName Language)
forall a. Maybe a
Nothing) (LocalEnvironment Language -> Environment Language)
-> IO (LocalEnvironment Language) -> IO (Environment Language)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (LocalEnvironment Language)
unqualifiedPreludeBindings

unqualifiedPreludeBindings :: IO (Binder.LocalEnvironment AST.Language)
unqualifiedPreludeBindings :: IO (LocalEnvironment Language)
unqualifiedPreludeBindings = do
   preludeModuleDir <- (FilePath -> FilePath -> FilePath)
-> FilePath -> FilePath -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> FilePath
combine FilePath
"report" (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getDataDir
   moduleFileNames <- filter (List.isSuffixOf ".hs") <$> listDirectory preludeModuleDir
   moduleTexts <- mapM (unsafeInterleaveIO . Text.IO.readFile . combine preludeModuleDir) moduleFileNames
   let Just moduleNames = traverse (Text.stripSuffix ".hs" . Text.pack) moduleFileNames
       parsedModules = ParseResults Input [Bound (Module Language Language Bound Bound)]
-> Bound (Module Language Language Bound Bound)
forall {a} {a}. Either a [a] -> a
assertSuccess (ParseResults Input [Bound (Module Language Language Bound Bound)]
 -> Bound (Module Language Language Bound Bound))
-> (Text
    -> ParseResults
         Input [Bound (Module Language Language Bound Bound)])
-> Text
-> Bound (Module Language Language Bound Bound)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Extension Bool
-> ModuleEnvironment Language
-> Environment Language
-> Bool
-> Text
-> ParseResults
     Input [Bound (Module Language Language Bound Bound)]
parseModule Map Extension Bool
defaultExtensions ModuleEnvironment Language
moduleEnv Environment Language
forall a. Monoid a => a
mempty Bool
False (Text -> Bound (Module Language Language Bound Bound))
-> [Text] -> [Bound (Module Language Language Bound Bound)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
moduleTexts
       assertSuccess ~(Right ~[a
parsed]) = a
parsed
       moduleEnv = Map (ModuleName Language) (LocalEnvironment Language)
-> ModuleEnvironment Language
forall (f :: * -> *) m. f m -> UnionWith f m
UnionWith (Map (ModuleName Language) (LocalEnvironment Language)
 -> ModuleEnvironment Language)
-> Map (ModuleName Language) (LocalEnvironment Language)
-> ModuleEnvironment Language
forall a b. (a -> b) -> a -> b
$ [(ModuleName Language, LocalEnvironment Language)]
-> Map (ModuleName Language) (LocalEnvironment Language)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ModuleName Language, LocalEnvironment Language)]
 -> Map (ModuleName Language) (LocalEnvironment Language))
-> [(ModuleName Language, LocalEnvironment Language)]
-> Map (ModuleName Language) (LocalEnvironment Language)
forall a b. (a -> b) -> a -> b
$ [ModuleName Language]
-> [LocalEnvironment Language]
-> [(ModuleName Language, LocalEnvironment Language)]
forall a b. [a] -> [b] -> [(a, b)]
zip (forall λ. Haskell λ => NonEmpty (Name λ) -> ModuleName λ
Abstract.moduleName @AST.Language (NonEmpty (Name Language) -> ModuleName Language)
-> (Text -> NonEmpty (Name Language))
-> Text
-> ModuleName Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name Language -> NonEmpty (Name Language)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name Language -> NonEmpty (Name Language))
-> (Text -> Name Language) -> Text -> NonEmpty (Name Language)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Name Language
Text -> Name Language
forall λ. Haskell λ => Text -> Name λ
Abstract.name (Text -> ModuleName Language) -> [Text] -> [ModuleName Language]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
moduleNames) (Attributes Language -> LocalEnvironment Language
forall a b. Atts a b -> b
Di.syn (Attributes Language -> LocalEnvironment Language)
-> (Bound (Module Language Language Bound Bound)
    -> Attributes Language)
-> Bound (Module Language Language Bound Bound)
-> LocalEnvironment Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attributes Language,
 Placed (Module Language Language Bound Bound))
-> Attributes Language
forall a b. (a, b) -> a
fst ((Attributes Language,
  Placed (Module Language Language Bound Bound))
 -> Attributes Language)
-> (Bound (Module Language Language Bound Bound)
    -> (Attributes Language,
        Placed (Module Language Language Bound Bound)))
-> Bound (Module Language Language Bound Bound)
-> Attributes Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound (Module Language Language Bound Bound)
-> (Attributes Language,
    Placed (Module Language Language Bound Bound))
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Bound (Module Language Language Bound Bound)
 -> LocalEnvironment Language)
-> [Bound (Module Language Language Bound Bound)]
-> [LocalEnvironment Language]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bound (Module Language Language Bound Bound)]
parsedModules)
       Just prelude = Map.lookup Binder.preludeName (getUnionWith moduleEnv)
       defaultExtensions = (Extension -> Bool) -> Set Extension -> Map Extension Bool
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Bool -> Extension -> Bool
forall a b. a -> b -> a
const Bool
True) Set Extension
Extensions.includedByDefault
   pure prelude