module RnUnbound ( mkUnboundName
                 , mkUnboundNameRdr
                 , isUnboundName
                 , reportUnboundName
                 , unknownNameSuggestions
                 , WhereLooking(..)
                 , unboundName
                 , unboundNameX
                 , notInScopeErr ) where
import GhcPrelude
import RdrName
import HscTypes
import TcRnMonad
import Name
import Module
import SrcLoc
import Outputable
import PrelNames ( mkUnboundName, isUnboundName, getUnique)
import Util
import Maybes
import DynFlags
import FastString
import Data.List
import Data.Function ( on )
import UniqDFM (udfmToList)
data WhereLooking = WL_Any        
                  | WL_Global     
                  | WL_LocalTop   
                  | WL_LocalOnly
                        
                        
                        
mkUnboundNameRdr :: RdrName -> Name
mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr)
reportUnboundName :: RdrName -> RnM Name
reportUnboundName rdr = unboundName WL_Any rdr
unboundName :: WhereLooking -> RdrName -> RnM Name
unboundName wl rdr = unboundNameX wl rdr Outputable.empty
unboundNameX :: WhereLooking -> RdrName -> SDoc -> RnM Name
unboundNameX where_look rdr_name extra
  = do  { dflags <- getDynFlags
        ; let show_helpful_errors = gopt Opt_HelpfulErrors dflags
              err = notInScopeErr rdr_name $$ extra
        ; if not show_helpful_errors
          then addErr err
          else do { local_env  <- getLocalRdrEnv
                  ; global_env <- getGlobalRdrEnv
                  ; impInfo <- getImports
                  ; currmod <- getModule
                  ; hpt <- getHpt
                  ; let suggestions = unknownNameSuggestions_ where_look
                          dflags hpt currmod global_env local_env impInfo
                          rdr_name
                  ; addErr (err $$ suggestions) }
        ; return (mkUnboundNameRdr rdr_name) }
notInScopeErr :: RdrName -> SDoc
notInScopeErr rdr_name
  = hang (text "Not in scope:")
       2 (what <+> quotes (ppr rdr_name))
  where
    what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
type HowInScope = Either SrcSpan ImpDeclSpec
     
     
unknownNameSuggestions :: DynFlags
                       -> HomePackageTable -> Module
                       -> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails
                       -> RdrName -> SDoc
unknownNameSuggestions = unknownNameSuggestions_ WL_Any
unknownNameSuggestions_ :: WhereLooking -> DynFlags
                       -> HomePackageTable -> Module
                       -> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails
                       -> RdrName -> SDoc
unknownNameSuggestions_ where_look dflags hpt curr_mod global_env local_env
                          imports tried_rdr_name =
    similarNameSuggestions where_look dflags global_env local_env tried_rdr_name $$
    importSuggestions where_look global_env hpt
                      curr_mod imports tried_rdr_name $$
    extensionSuggestions tried_rdr_name
similarNameSuggestions :: WhereLooking -> DynFlags
                        -> GlobalRdrEnv -> LocalRdrEnv
                        -> RdrName -> SDoc
similarNameSuggestions where_look dflags global_env
                        local_env tried_rdr_name
  = case suggest of
      []  -> Outputable.empty
      [p] -> perhaps <+> pp_item p
      ps  -> sep [ perhaps <+> text "one of these:"
                 , nest 2 (pprWithCommas pp_item ps) ]
  where
    all_possibilities :: [(String, (RdrName, HowInScope))]
    all_possibilities
       =  [ (showPpr dflags r, (r, Left loc))
          | (r,loc) <- local_possibilities local_env ]
       ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ]
    suggest = fuzzyLookup (showPpr dflags tried_rdr_name) all_possibilities
    perhaps = text "Perhaps you meant"
    pp_item :: (RdrName, HowInScope) -> SDoc
    pp_item (rdr, Left loc) = pp_ns rdr <+> quotes (ppr rdr) <+> loc' 
        where loc' = case loc of
                     UnhelpfulSpan l -> parens (ppr l)
                     RealSrcSpan l -> parens (text "line" <+> int (srcSpanStartLine l))
    pp_item (rdr, Right is) = pp_ns rdr <+> quotes (ppr rdr) <+>   
                              parens (text "imported from" <+> ppr (is_mod is))
    pp_ns :: RdrName -> SDoc
    pp_ns rdr | ns /= tried_ns = pprNameSpace ns
              | otherwise      = Outputable.empty
      where ns = rdrNameSpace rdr
    tried_occ     = rdrNameOcc tried_rdr_name
    tried_is_sym  = isSymOcc tried_occ
    tried_ns      = occNameSpace tried_occ
    tried_is_qual = isQual tried_rdr_name
    correct_name_space occ =  nameSpacesRelated (occNameSpace occ) tried_ns
                           && isSymOcc occ == tried_is_sym
        
        
        
    local_ok = case where_look of { WL_Any -> True
                                  ; WL_LocalOnly -> True
                                  ; _ -> False }
    local_possibilities :: LocalRdrEnv -> [(RdrName, SrcSpan)]
    local_possibilities env
      | tried_is_qual = []
      | not local_ok  = []
      | otherwise     = [ (mkRdrUnqual occ, nameSrcSpan name)
                        | name <- localRdrEnvElts env
                        , let occ = nameOccName name
                        , correct_name_space occ]
    global_possibilities :: GlobalRdrEnv -> [(RdrName, (RdrName, HowInScope))]
    global_possibilities global_env
      | tried_is_qual = [ (rdr_qual, (rdr_qual, how))
                        | gre <- globalRdrEnvElts global_env
                        , isGreOk where_look gre
                        , let name = gre_name gre
                              occ  = nameOccName name
                        , correct_name_space occ
                        , (mod, how) <- qualsInScope gre
                        , let rdr_qual = mkRdrQual mod occ ]
      | otherwise = [ (rdr_unqual, pair)
                    | gre <- globalRdrEnvElts global_env
                    , isGreOk where_look gre
                    , let name = gre_name gre
                          occ  = nameOccName name
                          rdr_unqual = mkRdrUnqual occ
                    , correct_name_space occ
                    , pair <- case (unquals_in_scope gre, quals_only gre) of
                                (how:_, _)    -> [ (rdr_unqual, how) ]
                                ([],    pr:_) -> [ pr ]  
                                ([],    [])   -> [] ]
              
              
              
              
              
              
              
              
              
    
    unquals_in_scope :: GlobalRdrElt -> [HowInScope]
    unquals_in_scope (GRE { gre_name = n, gre_lcl = lcl, gre_imp = is })
      | lcl       = [ Left (nameSrcSpan n) ]
      | otherwise = [ Right ispec
                    | i <- is, let ispec = is_decl i
                    , not (is_qual ispec) ]
    
    quals_only :: GlobalRdrElt -> [(RdrName, HowInScope)]
    
    quals_only (GRE { gre_name = n, gre_imp = is })
      = [ (mkRdrQual (is_as ispec) (nameOccName n), Right ispec)
        | i <- is, let ispec = is_decl i, is_qual ispec ]
importSuggestions :: WhereLooking
                  -> GlobalRdrEnv
                  -> HomePackageTable -> Module
                  -> ImportAvails -> RdrName -> SDoc
importSuggestions where_look global_env hpt currMod imports rdr_name
  | WL_LocalOnly <- where_look                 = Outputable.empty
  | not (isQual rdr_name || isUnqual rdr_name) = Outputable.empty
  | null interesting_imports
  , Just name <- mod_name
  , show_not_imported_line name
  = hsep
      [ text "No module named"
      , quotes (ppr name)
      , text "is imported."
      ]
  | is_qualified
  , null helpful_imports
  , [(mod,_)] <- interesting_imports
  = hsep
      [ text "Module"
      , quotes (ppr mod)
      , text "does not export"
      , quotes (ppr occ_name) <> dot
      ]
  | is_qualified
  , null helpful_imports
  , not (null interesting_imports)
  , mods <- map fst interesting_imports
  = hsep
      [ text "Neither"
      , quotedListWithNor (map ppr mods)
      , text "exports"
      , quotes (ppr occ_name) <> dot
      ]
  | [(mod,imv)] <- helpful_imports_non_hiding
  = fsep
      [ text "Perhaps you want to add"
      , quotes (ppr occ_name)
      , text "to the import list"
      , text "in the import of"
      , quotes (ppr mod)
      , parens (ppr (imv_span imv)) <> dot
      ]
  | not (null helpful_imports_non_hiding)
  = fsep
      [ text "Perhaps you want to add"
      , quotes (ppr occ_name)
      , text "to one of these import lists:"
      ]
    $$
    nest 2 (vcat
        [ quotes (ppr mod) <+> parens (ppr (imv_span imv))
        | (mod,imv) <- helpful_imports_non_hiding
        ])
  | [(mod,imv)] <- helpful_imports_hiding
  = fsep
      [ text "Perhaps you want to remove"
      , quotes (ppr occ_name)
      , text "from the explicit hiding list"
      , text "in the import of"
      , quotes (ppr mod)
      , parens (ppr (imv_span imv)) <> dot
      ]
  | not (null helpful_imports_hiding)
  = fsep
      [ text "Perhaps you want to remove"
      , quotes (ppr occ_name)
      , text "from the hiding clauses"
      , text "in one of these imports:"
      ]
    $$
    nest 2 (vcat
        [ quotes (ppr mod) <+> parens (ppr (imv_span imv))
        | (mod,imv) <- helpful_imports_hiding
        ])
  | otherwise
  = Outputable.empty
 where
  is_qualified = isQual rdr_name
  (mod_name, occ_name) = case rdr_name of
    Unqual occ_name        -> (Nothing, occ_name)
    Qual mod_name occ_name -> (Just mod_name, occ_name)
    _                      -> error "importSuggestions: dead code"
  
  
  interesting_imports = [ (mod, imp)
    | (mod, mod_imports) <- moduleEnvToList (imp_mods imports)
    , Just imp <- return $ pick (importedByUser mod_imports)
    ]
  
  
  pick :: [ImportedModsVal] -> Maybe ImportedModsVal
  pick = listToMaybe . sortBy (compare `on` prefer) . filter select
    where select imv = case mod_name of Just name -> imv_name imv == name
                                        Nothing   -> not (imv_qualified imv)
          prefer imv = (imv_is_hiding imv, imv_span imv)
  
  
  
  helpful_imports = filter helpful interesting_imports
    where helpful (_,imv)
            = not . null $ lookupGlobalRdrEnv (imv_all_exports imv) occ_name
  
  
  (helpful_imports_hiding, helpful_imports_non_hiding)
    = partition (imv_is_hiding . snd) helpful_imports
  
  show_not_imported_line :: ModuleName -> Bool                    
  show_not_imported_line modnam
      | modnam `elem` globMods                = False    
      | moduleName currMod == modnam          = False                  
      | is_last_loaded_mod modnam hpt_uniques = False                  
      | otherwise                             = True
    where
      hpt_uniques = map fst (udfmToList hpt)
      is_last_loaded_mod _ []         = False
      is_last_loaded_mod modnam uniqs = last uniqs == getUnique modnam
      globMods = nub [ mod
                     | gre <- globalRdrEnvElts global_env
                     , isGreOk where_look gre
                     , (mod, _) <- qualsInScope gre
                     ]
extensionSuggestions :: RdrName -> SDoc
extensionSuggestions rdrName
  | rdrName == mkUnqual varName (fsLit "mdo") ||
    rdrName == mkUnqual varName (fsLit "rec")
      = text "Perhaps you meant to use RecursiveDo"
  | otherwise = Outputable.empty
qualsInScope :: GlobalRdrElt -> [(ModuleName, HowInScope)]
qualsInScope GRE { gre_name = n, gre_lcl = lcl, gre_imp = is }
      | lcl = case nameModule_maybe n of
                Nothing -> []
                Just m  -> [(moduleName m, Left (nameSrcSpan n))]
      | otherwise = [ (is_as ispec, Right ispec)
                    | i <- is, let ispec = is_decl i ]
isGreOk :: WhereLooking -> GlobalRdrElt -> Bool
isGreOk where_look = case where_look of
                         WL_LocalTop  -> isLocalGRE
                         WL_LocalOnly -> const False
                         _            -> const True