<commit_before>{-# LANGUAGE MagicHash #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Haddock.Interface.AttachInstances
-- Copyright   :  (c) <NAME> 2006,
--                    <NAME>  2006-2009,
--                    <NAME> 2009
-- License     :  BSD-like
--
-- Maintainer  :  <EMAIL>
-- Stability   :  experimental
-- Portability :  portable
-----------------------------------------------------------------------------
module Haddock.Interface.AttachInstances (attachInstances) where


import Haddock.Types
import Haddock.Convert

import Control.Arrow
import Data.List
import qualified Data.Map as Map

import GHC
import Name
import InstEnv
import Class
import GhcMonad (withSession)
import TysPrim( funTyCon )
import MonadUtils (liftIO)
import TcRnDriver (tcRnGetInfo)
import TypeRep
import Var hiding (varName)
import TyCon
import PrelNames
import FastString
#define FSLIT(x) (mkFastString# (x#))


attachInstances :: [Interface] -> InstIfaceMap -> Ghc [Interface]
attachInstances ifaces instIfaceMap = mapM attach ifaces
  where
    -- TODO: take an IfaceMap as input
    ifaceMap = Map.fromList [ (ifaceMod i, i) | i <- ifaces ]

    attach iface = do
      newItems <- mapM (attachToExportItem iface ifaceMap instIfaceMap)
                       (ifaceExportItems iface)
      return $ iface { ifaceExportItems = newItems }


attachToExportItem :: Interface -> IfaceMap -> InstIfaceMap -> ExportItem Name -> Ghc (ExportItem Name)
attachToExportItem iface ifaceMap instIfaceMap export =
  case export of
    ExportDecl { expItemDecl = L _ (TyClD d) } -> do
      mb_info <- getAllInfo (tcdName d)
      let export' =
            export {
              expItemInstances =
                case mb_info of
                  Just (_, _, instances) ->
                    let insts = map (first synifyInstHead) $ sortImage (first instHead)
                                [ (instanceHead i, getName i) | i <- instances ]
                    in [ (inst, lookupInstDoc name iface ifaceMap instIfaceMap)
                       | (inst, name) <- insts ]
                  Nothing -> []
            }
      return export'
    _ -> return export


lookupInstDoc :: Name -> Interface -> IfaceMap -> InstIfaceMap -> Maybe (Doc Name)
-- TODO: capture this pattern in a function (when we have streamlined the
-- handling of instances)
lookupInstDoc name iface ifaceMap instIfaceMap =
  case Map.lookup name (ifaceDocMap iface) of
    Just doc -> Just doc
    Nothing ->
      case Map.lookup modName ifaceMap of
        Just iface2 -><commit_msg>Use InstEnv.instanceSig rather than instanceHead (name change)<commit_after>{-# LANGUAGE MagicHash #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Haddock.Interface.AttachInstances
-- Copyright   :  (c) <NAME> 2006,
--                    <NAME>  2006-2009,
--                    <NAME> 2009
-- License     :  BSD-like
--
-- Maintainer  :  <EMAIL>
-- Stability   :  experimental
-- Portability :  portable
-----------------------------------------------------------------------------
module Haddock.Interface.AttachInstances (attachInstances) where


import Haddock.Types
import Haddock.Convert

import Control.Arrow
import Data.List
import qualified Data.Map as Map

import GHC
import Name
import InstEnv
import Class
import GhcMonad (withSession)
import TysPrim( funTyCon )
import MonadUtils (liftIO)
import TcRnDriver (tcRnGetInfo)
import TypeRep
import Var hiding (varName)
import TyCon
import PrelNames
import FastString
#define FSLIT(x) (mkFastString# (x#))


attachInstances :: [Interface] -> InstIfaceMap -> Ghc [Interface]
attachInstances ifaces instIfaceMap = mapM attach ifaces
  where
    -- TODO: take an IfaceMap as input
    ifaceMap = Map.fromList [ (ifaceMod i, i) | i <- ifaces ]

    attach iface = do
      newItems <- mapM (attachToExportItem iface ifaceMap instIfaceMap)
                       (ifaceExportItems iface)
      return $ iface { ifaceExportItems = newItems }


attachToExportItem :: Interface -> IfaceMap -> InstIfaceMap -> ExportItem Name -> Ghc (ExportItem Name)
attachToExportItem iface ifaceMap instIfaceMap export =
  case export of
    ExportDecl { expItemDecl = L _ (TyClD d) } -> do
      mb_info <- getAllInfo (tcdName d)
      let export' =
            export {
              expItemInstances =
                case mb_info of
                  Just (_, _, instances) ->
                    let insts = map (first synifyInstHead) $ sortImage (first instHead)
                                [ (instanceSig i, getName i) | i <- instances ]
                    in [ (inst, lookupInstDoc name iface ifaceMap instIfaceMap)
                       | (inst, name) <- insts ]
                  Nothing -> []
            }
      return export'
    _ -> return export


lookupInstDoc :: Name -> Interface -> IfaceMap -> InstIfaceMap -> Maybe (Doc Name)
-- TODO: capture this pattern in a function (when we have streamlined the
-- handling of instances)
lookupInstDoc name iface ifaceMap instIfaceMap =
  case Map.lookup name (ifaceDocMap iface) of
    Just doc -> Just doc
    Nothing ->
      case Map.lookup modName ifaceMap of
        Just iface2 ->
{'fraction_non_alphanumeric': 0.14032073310423826, 'fraction_numerical': 0.006491027109583811, 'mean_word_length': 1.966591166477916, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 45, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7137238', 'n_tokens_mistral': 1512, 'n_tokens_neox': 1442, 'n_words': 456}