-- Copyright (c) 2019 The DAML Authors. All rights reserved.

-- SPDX-License-Identifier: Apache-2.0


{-# LANGUAGE CPP #-}
#include "ghc-api-version.h"

module Development.IDE.Import.FindImports
  ( locateModule
  , Import(..)
  , ArtifactsLocation(..)
  , modSummaryToArtifactsLocation
  , isBootLocation
  , mkImportDirs
  ) where

import           Development.IDE.GHC.Error as ErrUtils
import Development.IDE.GHC.Orphans()
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Development.IDE.GHC.Compat
-- GHC imports

import           FastString
import qualified Module                      as M
import           Packages
import           Outputable                  (showSDoc, ppr, pprPanic)
import           Finder
import Control.DeepSeq

-- standard imports

import           Control.Monad.Extra
import           Control.Monad.IO.Class
import           System.FilePath
import DriverPhases
import Data.Maybe
import Data.List (isSuffixOf)

data Import
  = FileImport !ArtifactsLocation
  | PackageImport !M.InstalledUnitId
  deriving (Int -> Import -> ShowS
[Import] -> ShowS
Import -> String
(Int -> Import -> ShowS)
-> (Import -> String) -> ([Import] -> ShowS) -> Show Import
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Import] -> ShowS
$cshowList :: [Import] -> ShowS
show :: Import -> String
$cshow :: Import -> String
showsPrec :: Int -> Import -> ShowS
$cshowsPrec :: Int -> Import -> ShowS
Show)

data ArtifactsLocation = ArtifactsLocation
  { ArtifactsLocation -> NormalizedFilePath
artifactFilePath    :: !NormalizedFilePath
  , ArtifactsLocation -> Maybe ModLocation
artifactModLocation :: !(Maybe ModLocation)
  , ArtifactsLocation -> Bool
artifactIsSource    :: !Bool          -- ^ True if a module is a source input

  }
    deriving (Int -> ArtifactsLocation -> ShowS
[ArtifactsLocation] -> ShowS
ArtifactsLocation -> String
(Int -> ArtifactsLocation -> ShowS)
-> (ArtifactsLocation -> String)
-> ([ArtifactsLocation] -> ShowS)
-> Show ArtifactsLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArtifactsLocation] -> ShowS
$cshowList :: [ArtifactsLocation] -> ShowS
show :: ArtifactsLocation -> String
$cshow :: ArtifactsLocation -> String
showsPrec :: Int -> ArtifactsLocation -> ShowS
$cshowsPrec :: Int -> ArtifactsLocation -> ShowS
Show)

instance NFData ArtifactsLocation where
  rnf :: ArtifactsLocation -> ()
rnf ArtifactsLocation{Bool
Maybe ModLocation
NormalizedFilePath
artifactIsSource :: Bool
artifactModLocation :: Maybe ModLocation
artifactFilePath :: NormalizedFilePath
artifactIsSource :: ArtifactsLocation -> Bool
artifactModLocation :: ArtifactsLocation -> Maybe ModLocation
artifactFilePath :: ArtifactsLocation -> NormalizedFilePath
..} = NormalizedFilePath -> ()
forall a. NFData a => a -> ()
rnf NormalizedFilePath
artifactFilePath () -> () -> ()
`seq` Maybe ModLocation -> ()
forall a. a -> ()
rwhnf Maybe ModLocation
artifactModLocation () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
artifactIsSource

isBootLocation :: ArtifactsLocation -> Bool
isBootLocation :: ArtifactsLocation -> Bool
isBootLocation = Bool -> Bool
not (Bool -> Bool)
-> (ArtifactsLocation -> Bool) -> ArtifactsLocation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArtifactsLocation -> Bool
artifactIsSource

instance NFData Import where
  rnf :: Import -> ()
rnf (FileImport ArtifactsLocation
x) = ArtifactsLocation -> ()
forall a. NFData a => a -> ()
rnf ArtifactsLocation
x
  rnf (PackageImport InstalledUnitId
x) = InstalledUnitId -> ()
forall a. NFData a => a -> ()
rnf InstalledUnitId
x

modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation
modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation
modSummaryToArtifactsLocation NormalizedFilePath
nfp Maybe ModSummary
ms = NormalizedFilePath
-> Maybe ModLocation -> Bool -> ArtifactsLocation
ArtifactsLocation NormalizedFilePath
nfp (ModSummary -> ModLocation
ms_location (ModSummary -> ModLocation)
-> Maybe ModSummary -> Maybe ModLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModSummary
ms) Bool
source
  where
    isSource :: HscSource -> Bool
isSource HscSource
HsSrcFile = Bool
True
    isSource HscSource
_ = Bool
False
    source :: Bool
source = case Maybe ModSummary
ms of
      Maybe ModSummary
Nothing -> String
"-boot" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
nfp
      Just ModSummary
ms -> HscSource -> Bool
isSource (ModSummary -> HscSource
ms_hsc_src ModSummary
ms)

-- | locate a module in the file system. Where we go from *daml to Haskell

locateModuleFile :: MonadIO m
             => [[FilePath]]
             -> [String]
             -> (ModuleName -> NormalizedFilePath -> m Bool)
             -> Bool
             -> ModuleName
             -> m (Maybe NormalizedFilePath)
locateModuleFile :: [[String]]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
locateModuleFile [[String]]
import_dirss [String]
exts ModuleName -> NormalizedFilePath -> m Bool
doesExist Bool
isSource ModuleName
modName = do
  let candidates :: [String] -> [NormalizedFilePath]
candidates [String]
import_dirs =
        [ String -> NormalizedFilePath
toNormalizedFilePath' (String
prefix String -> ShowS
</> ModuleName -> String
M.moduleNameSlashes ModuleName
modName String -> ShowS
<.> ShowS
maybeBoot String
ext)
           | String
prefix <- [String]
import_dirs , String
ext <- [String]
exts]
  (NormalizedFilePath -> m Bool)
-> [NormalizedFilePath] -> m (Maybe NormalizedFilePath)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM (ModuleName -> NormalizedFilePath -> m Bool
doesExist ModuleName
modName) (([String] -> [NormalizedFilePath])
-> [[String]] -> [NormalizedFilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [String] -> [NormalizedFilePath]
candidates [[String]]
import_dirss)
  where
    maybeBoot :: ShowS
maybeBoot String
ext
      | Bool
isSource = String
ext String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-boot"
      | Bool
otherwise = String
ext

-- | This function is used to map a package name to a set of import paths.

-- It only returns Just for unit-ids which are possible to import into the

-- current module. In particular, it will return Nothing for 'main' components

-- as they can never be imported into another package.

mkImportDirs :: DynFlags -> (M.InstalledUnitId, DynFlags) -> Maybe (PackageName, [FilePath])
mkImportDirs :: DynFlags
-> (InstalledUnitId, DynFlags) -> Maybe (PackageName, [String])
mkImportDirs DynFlags
df (InstalledUnitId
i, DynFlags{[String]
importPaths :: DynFlags -> [String]
importPaths :: [String]
importPaths}) = (, [String]
importPaths) (PackageName -> (PackageName, [String]))
-> Maybe PackageName -> Maybe (PackageName, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> InstalledUnitId -> Maybe PackageName
getPackageName DynFlags
df InstalledUnitId
i

-- | locate a module in either the file system or the package database. Where we go from *daml to

-- Haskell

locateModule
    :: MonadIO m
    => DynFlags
    -> [(M.InstalledUnitId, DynFlags)] -- ^ Import directories

    -> [String]                        -- ^ File extensions

    -> (ModuleName -> NormalizedFilePath -> m Bool)  -- ^ does file exist predicate

    -> Located ModuleName              -- ^ Moudle name

    -> Maybe FastString                -- ^ Package name

    -> Bool                            -- ^ Is boot module

    -> m (Either [FileDiagnostic] Import)
locateModule :: DynFlags
-> [(InstalledUnitId, DynFlags)]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Located ModuleName
-> Maybe FastString
-> Bool
-> m (Either [FileDiagnostic] Import)
locateModule DynFlags
dflags [(InstalledUnitId, DynFlags)]
comp_info [String]
exts ModuleName -> NormalizedFilePath -> m Bool
doesExist Located ModuleName
modName Maybe FastString
mbPkgName Bool
isSource = do
  case Maybe FastString
mbPkgName of
    -- "this" means that we should only look in the current package

    Just FastString
"this" -> do
      [[String]] -> m (Either [FileDiagnostic] Import)
lookupLocal [DynFlags -> [String]
importPaths DynFlags
dflags]
    -- if a package name is given we only go look for a package

    Just FastString
pkgName
      | Just [String]
dirs <- PackageName -> [(PackageName, [String])] -> Maybe [String]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FastString -> PackageName
PackageName FastString
pkgName) [(PackageName, [String])]
import_paths
          -> [[String]] -> m (Either [FileDiagnostic] Import)
lookupLocal [[String]
dirs]
      | Bool
otherwise -> DynFlags -> m (Either [FileDiagnostic] Import)
forall (m :: * -> *).
Monad m =>
DynFlags -> m (Either [FileDiagnostic] Import)
lookupInPackageDB DynFlags
dflags
    Maybe FastString
Nothing -> do
      -- first try to find the module as a file. If we can't find it try to find it in the package

      -- database.

      -- Here the importPaths for the current modules are added to the front of the import paths from the other components.

      -- This is particularly important for Paths_* modules which get generated for every component but unless you use it in

      -- each component will end up being found in the wrong place and cause a multi-cradle match failure.

      Maybe NormalizedFilePath
mbFile <- [[String]]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
forall (m :: * -> *).
MonadIO m =>
[[String]]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
locateModuleFile (DynFlags -> [String]
importPaths DynFlags
dflags [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: ((PackageName, [String]) -> [String])
-> [(PackageName, [String])] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName, [String]) -> [String]
forall a b. (a, b) -> b
snd [(PackageName, [String])]
import_paths) [String]
exts ModuleName -> NormalizedFilePath -> m Bool
doesExist Bool
isSource (ModuleName -> m (Maybe NormalizedFilePath))
-> ModuleName -> m (Maybe NormalizedFilePath)
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
modName
      case Maybe NormalizedFilePath
mbFile of
        Maybe NormalizedFilePath
Nothing -> DynFlags -> m (Either [FileDiagnostic] Import)
forall (m :: * -> *).
Monad m =>
DynFlags -> m (Either [FileDiagnostic] Import)
lookupInPackageDB DynFlags
dflags
        Just NormalizedFilePath
file -> NormalizedFilePath -> m (Either [FileDiagnostic] Import)
forall (m :: * -> *) a.
MonadIO m =>
NormalizedFilePath -> m (Either a Import)
toModLocation NormalizedFilePath
file
  where
    import_paths :: [(PackageName, [String])]
import_paths = ((InstalledUnitId, DynFlags) -> Maybe (PackageName, [String]))
-> [(InstalledUnitId, DynFlags)] -> [(PackageName, [String])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DynFlags
-> (InstalledUnitId, DynFlags) -> Maybe (PackageName, [String])
mkImportDirs DynFlags
dflags) [(InstalledUnitId, DynFlags)]
comp_info
    toModLocation :: NormalizedFilePath -> m (Either a Import)
toModLocation NormalizedFilePath
file = IO (Either a Import) -> m (Either a Import)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either a Import) -> m (Either a Import))
-> IO (Either a Import) -> m (Either a Import)
forall a b. (a -> b) -> a -> b
$ do
        ModLocation
loc <- DynFlags -> ModuleName -> String -> IO ModLocation
mkHomeModLocation DynFlags
dflags (Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
modName) (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
file)
        Either a Import -> IO (Either a Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a Import -> IO (Either a Import))
-> Either a Import -> IO (Either a Import)
forall a b. (a -> b) -> a -> b
$ Import -> Either a Import
forall a b. b -> Either a b
Right (Import -> Either a Import) -> Import -> Either a Import
forall a b. (a -> b) -> a -> b
$ ArtifactsLocation -> Import
FileImport (ArtifactsLocation -> Import) -> ArtifactsLocation -> Import
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath
-> Maybe ModLocation -> Bool -> ArtifactsLocation
ArtifactsLocation NormalizedFilePath
file (ModLocation -> Maybe ModLocation
forall a. a -> Maybe a
Just ModLocation
loc) (Bool -> Bool
not Bool
isSource)

    lookupLocal :: [[String]] -> m (Either [FileDiagnostic] Import)
lookupLocal [[String]]
dirs = do
      Maybe NormalizedFilePath
mbFile <- [[String]]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
forall (m :: * -> *).
MonadIO m =>
[[String]]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
locateModuleFile [[String]]
dirs [String]
exts ModuleName -> NormalizedFilePath -> m Bool
doesExist Bool
isSource (ModuleName -> m (Maybe NormalizedFilePath))
-> ModuleName -> m (Maybe NormalizedFilePath)
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
modName
      case Maybe NormalizedFilePath
mbFile of
        Maybe NormalizedFilePath
Nothing -> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [FileDiagnostic] Import
 -> m (Either [FileDiagnostic] Import))
-> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall a b. (a -> b) -> a -> b
$ [FileDiagnostic] -> Either [FileDiagnostic] Import
forall a b. a -> Either a b
Left ([FileDiagnostic] -> Either [FileDiagnostic] Import)
-> [FileDiagnostic] -> Either [FileDiagnostic] Import
forall a b. (a -> b) -> a -> b
$ DynFlags -> Located ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr DynFlags
dflags Located ModuleName
modName (LookupResult -> [FileDiagnostic])
-> LookupResult -> [FileDiagnostic]
forall a b. (a -> b) -> a -> b
$ [ModuleSuggestion] -> LookupResult
LookupNotFound []
        Just NormalizedFilePath
file -> NormalizedFilePath -> m (Either [FileDiagnostic] Import)
forall (m :: * -> *) a.
MonadIO m =>
NormalizedFilePath -> m (Either a Import)
toModLocation NormalizedFilePath
file

    lookupInPackageDB :: DynFlags -> m (Either [FileDiagnostic] Import)
lookupInPackageDB DynFlags
dfs =
      case DynFlags -> ModuleName -> Maybe FastString -> LookupResult
lookupModuleWithSuggestions DynFlags
dfs (Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
modName) Maybe FastString
mbPkgName of
        LookupFound Module
_m PackageConfig
pkgConfig -> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [FileDiagnostic] Import
 -> m (Either [FileDiagnostic] Import))
-> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall a b. (a -> b) -> a -> b
$ Import -> Either [FileDiagnostic] Import
forall a b. b -> Either a b
Right (Import -> Either [FileDiagnostic] Import)
-> Import -> Either [FileDiagnostic] Import
forall a b. (a -> b) -> a -> b
$ InstalledUnitId -> Import
PackageImport (InstalledUnitId -> Import) -> InstalledUnitId -> Import
forall a b. (a -> b) -> a -> b
$ PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId PackageConfig
pkgConfig
        LookupResult
reason -> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [FileDiagnostic] Import
 -> m (Either [FileDiagnostic] Import))
-> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall a b. (a -> b) -> a -> b
$ [FileDiagnostic] -> Either [FileDiagnostic] Import
forall a b. a -> Either a b
Left ([FileDiagnostic] -> Either [FileDiagnostic] Import)
-> [FileDiagnostic] -> Either [FileDiagnostic] Import
forall a b. (a -> b) -> a -> b
$ DynFlags -> Located ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr DynFlags
dfs Located ModuleName
modName LookupResult
reason

-- | Don't call this on a found module.

notFoundErr :: DynFlags -> Located M.ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr :: DynFlags -> Located ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr DynFlags
dfs Located ModuleName
modName LookupResult
reason =
  String -> [FileDiagnostic]
mkError' (String -> [FileDiagnostic]) -> String -> [FileDiagnostic]
forall a b. (a -> b) -> a -> b
$ SDoc -> String
ppr' (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ DynFlags -> ModuleName -> FindResult -> SDoc
cannotFindModule DynFlags
dfs ModuleName
modName0 (FindResult -> SDoc) -> FindResult -> SDoc
forall a b. (a -> b) -> a -> b
$ LookupResult -> FindResult
lookupToFindResult LookupResult
reason
  where
    mkError' :: String -> [FileDiagnostic]
mkError' = Text -> DiagnosticSeverity -> SrcSpan -> String -> [FileDiagnostic]
diagFromString Text
"not found" DiagnosticSeverity
DsError (Located ModuleName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located ModuleName
modName)
    modName0 :: SrcSpanLess (Located ModuleName)
modName0 = Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
modName
    ppr' :: SDoc -> String
ppr' = DynFlags -> SDoc -> String
showSDoc DynFlags
dfs
    -- We convert the lookup result to a find result to reuse GHC's cannotFindMoudle pretty printer.

    lookupToFindResult :: LookupResult -> FindResult
lookupToFindResult =
      \case
        LookupFound Module
_m PackageConfig
_pkgConfig ->
          String -> SDoc -> FindResult
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Impossible: called lookupToFind on found module." (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
modName0)
        LookupMultiple [(Module, ModuleOrigin)]
rs -> [(Module, ModuleOrigin)] -> FindResult
FoundMultiple [(Module, ModuleOrigin)]
rs
        LookupHidden [(Module, ModuleOrigin)]
pkg_hiddens [(Module, ModuleOrigin)]
mod_hiddens ->
          FindResult
notFound
             { fr_pkgs_hidden :: [UnitId]
fr_pkgs_hidden = ((Module, ModuleOrigin) -> UnitId)
-> [(Module, ModuleOrigin)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> UnitId
moduleUnitId (Module -> UnitId)
-> ((Module, ModuleOrigin) -> Module)
-> (Module, ModuleOrigin)
-> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Module, ModuleOrigin) -> Module
forall a b. (a, b) -> a
fst) [(Module, ModuleOrigin)]
pkg_hiddens
             , fr_mods_hidden :: [UnitId]
fr_mods_hidden = ((Module, ModuleOrigin) -> UnitId)
-> [(Module, ModuleOrigin)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> UnitId
moduleUnitId (Module -> UnitId)
-> ((Module, ModuleOrigin) -> Module)
-> (Module, ModuleOrigin)
-> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Module, ModuleOrigin) -> Module
forall a b. (a, b) -> a
fst) [(Module, ModuleOrigin)]
mod_hiddens
             }
        LookupUnusable [(Module, ModuleOrigin)]
unusable ->
          let unusables' :: [(UnitId, UnusablePackageReason)]
unusables' = ((Module, ModuleOrigin) -> (UnitId, UnusablePackageReason))
-> [(Module, ModuleOrigin)] -> [(UnitId, UnusablePackageReason)]
forall a b. (a -> b) -> [a] -> [b]
map (Module, ModuleOrigin) -> (UnitId, UnusablePackageReason)
get_unusable [(Module, ModuleOrigin)]
unusable
              get_unusable :: (Module, ModuleOrigin) -> (UnitId, UnusablePackageReason)
get_unusable (Module
m, ModUnusable UnusablePackageReason
r) = (Module -> UnitId
moduleUnitId Module
m, UnusablePackageReason
r)
              get_unusable (Module
_, ModuleOrigin
r) =
                String -> SDoc -> (UnitId, UnusablePackageReason)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"findLookupResult: unexpected origin" (ModuleOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleOrigin
r)
           in FindResult
notFound {fr_unusables :: [(UnitId, UnusablePackageReason)]
fr_unusables = [(UnitId, UnusablePackageReason)]
unusables'}
        LookupNotFound [ModuleSuggestion]
suggest ->
          FindResult
notFound {fr_suggestions :: [ModuleSuggestion]
fr_suggestions = [ModuleSuggestion]
suggest}

notFound :: FindResult
notFound :: FindResult
notFound = NotFound :: [String]
-> Maybe UnitId
-> [UnitId]
-> [UnitId]
-> [(UnitId, UnusablePackageReason)]
-> [ModuleSuggestion]
-> FindResult
NotFound
  { fr_paths :: [String]
fr_paths = []
  , fr_pkg :: Maybe UnitId
fr_pkg = Maybe UnitId
forall a. Maybe a
Nothing
  , fr_pkgs_hidden :: [UnitId]
fr_pkgs_hidden = []
  , fr_mods_hidden :: [UnitId]
fr_mods_hidden = []
  , fr_unusables :: [(UnitId, UnusablePackageReason)]
fr_unusables = []
  , fr_suggestions :: [ModuleSuggestion]
fr_suggestions = []
  }