<commit_before>{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GhcImportedFrom
-- Copyright   :  <NAME> 2013, 2014
-- License     :  BSD3
--
-- Maintainer  :  <EMAIL>
-- Stability   :  experimental
-- Portability :  portable
--
-- Synopsis: Attempt to guess the location of the Haddock HTML
-- documentation for a given symbol in a particular module, file, and
-- line/col location.
--
-- Latest development version: <https://github.com/carlohamalainen/ghc-imported-from>.

module Language.Haskell.GhcImportedFrom (
     QualifiedName(..)
   , Symbol(..)
   , GhcOptions(..)
   , GhcPkgOptions(..)
   , HaskellModule(..)
   , ghcOptionToGhcPKg
   , getGhcOptionsViaGhcMod
   , getGHCOptionsViaCradle
   , getCompilerOptionsViaGhcMod
   , modifyDFlags
   , setDynamicFlags
   , getTextualImports
   , getSummary
   , toHaskellModule
   , lookupSymbol
   , symbolImportedFrom
   , postfixMatch
   , moduleOfQualifiedName
   , qualifiedName
   , ghcPkgFindModule
   , ghcPkgHaddockUrl
   , moduleNameToHtmlFile
   , expandMatchingAsImport
   , specificallyMatches
   , toHackageUrl
   , bestPrefixMatches
   , findHaddockModule
   , matchToUrl
   , guessHaddockUrl
   , haddockUrl

   -- Things from Language.Haskell.GhcImportedFrom.Types
   , Options (..)
   , defaultOptions
   , LineSeparator (..)
   ) where

import Control.Applicative
import Control.Monad
import Control.Monad.Instances()
import Control.Monad.Writer
import Control.Monad.Trans as CMT
import Data.Function (on)
import Data.List
import Data.Maybe
import Data.Typeable()
import Desugar()
import DynFlags
import FastString
import GHC
import GHC.Paths (libdir)
import GHC.SYB.Utils()
import HscTypes
import Name
import Outputable
import RdrName
import System.Directory
import System.Environment()
import System.FilePath
import System.IO
import System.Process
import TcRnTypes()

import qualified DynFlags()
import qualified GhcMonad
import qualified MonadUtils()
import qualified Packages
import qualified SrcLoc
import qualified Safe

import Language.Haskell.GhcMod (
      findCradle
    , cradleCabalFile
    , cradleCabalDir
    , cradlePackageDbOpts
    )

import Language.Haskell.GhcMod.Internal (
    cabalAllBuildInfo
    , GHCOption
    , parseCabalFile
    , CompilerOptions (..)
    )

import Language.Haskell.GhcImportedFrom.UtilsFromGhcMod
import Language.Haskell.GhcImportedFrom.Types

type QualifiedName = String -- ^ A qualified name, e.g. @Foo.bar@.

type Symbol = String -- ^ A symbol, possibly qualified, e.g. @bar@ or @Foo.bar@.

newtype GhcOptions
    -- | List of user-supplied GHC options, refer to @tets@ subdirectory for example usage. Note that
    -- GHC API and ghc-pkg have inconsistencies in the naming of options, see <http://www.vex.net/~trebla/haskell/sicp.xhtml> for more details.
    = GhcOptions [String] deriving (Show)

newtype GhcPkgOptions
    -- | List of user-supplied ghc-pkg options.
    = GhcPkgOptions [String] deriving (Show)

data HaskellModule
    -- | Information about an import of a Haskell module.
    = HaskellModule { modName           :: String
                    , modQualifier      :: Maybe String
                    , modIsImplicit     :: Bool
                    , modHiding         :: [String]
                    , modImportedAs     :: Maybe String
                    , modSpecifically   :: [String]
                    } deriving (Show, Eq)

-- | Convert a GHC command line option to a @ghc-pkg@ command line option. This function
-- is incomplete; it only handles a few cases at the moment.
ghcOptionToGhcPKg :: [String] -> [String]
ghcOptionToGhcPKg [] = []
ghcOptionToGhcPKg (x:xs) = case x of "-no-user-package-db" -> "--no-user-package-db":ghcOptionToGhcPKg xs
                                     "-package-db"         -> ["--package-db", head xs] ++ ghcOptionToGhcPKg (tail xs)
                                     _                     -> error $ "Unknown GHC option: " ++ show (x:xs) -- FIXME Other cases?

-- | Use ghcmod's API to get the GHC options for a project. This uses 'findCradle', 'cradlePackageDbOpts', and 'GhcOptions'.
getGhcOptionsViaGhcMod :: IO GhcOptions
getGhcOptionsViaGhcMod = GhcOptions . cradlePackageDbOpts <$> findCradle

-- | Use ghcmod's API to get the GHC options for a project. This uses 'findCradle' and 'getGHCOptions.'
getGHCOptionsViaCradle :: IO [GHCOption]
getGHCOptionsViaCradle = do
    c <- findCradle
    pkgDesc <- GhcMonad.liftIO $ parseCabalFile $ fromJust $ cradleCabalFile c
    let binfo = head $ cabalAllBuildInfo pkgDesc
    getGHCOptions [] c (fromJust $ cradleCabalDir c) binfo

-- | Get compiler options using ghc-mod's API.
getCompilerOptionsViaGhcMod :: [GHCOption] -> IO CompilerOptions
getCompilerOptionsViaGhcMod ghcOpts0 = do
    cradle <- findCradle
    pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle
    getCompilerOptions ghcOpts0 cradle pkgDesc

-- | Add user-supplied GHC options to those discovered via ghc-mod.
modifyDFlags :: [String] -> DynFlags -> IO ([String], [GHCOption], DynFlags)
modifyDFlags ghcOpts0 dflags0 =
    defaultErrorHandler defaultFatalMessager defaultFlushOut $
        runGhc (Just libdir) $ do
            (GhcOptions ghcOpts1) <- GhcMonad.liftIO getGhcOptionsViaGhcMod
            ghcOpts2 <- GhcMonad.liftIO getGHCOptionsViaCradle

            (CompilerOptions compGhcOpts iPaths coDepPkgs) <- GhcMonad.liftIO $ getCompilerOptionsViaGhcMod ghcOpts0

            -- FIXME Need to log this info.
            -- GhcMonad.liftIO $ putStrLn $ "compGhcOpts: " ++ show compGhcOpts
            -- GhcMonad.liftIO $ putStrLn $ "iPaths: " ++ show iPaths
            -- GhcMonad.liftIO $ putStrLn $ "coDepPkgs: " ++ show coDepPkgs

            -- FIXME need to add ghcOpts1 and ghcOpts2 to the WriterT, but here
            -- we are inside the GhcMonad, so need to do some transformer stuff.
            -- Instead we laboriously return ghcOpts1 and ghcOpts2 up the call chain.
            -- GhcMonad.liftIO $ putStrLn $ "ghcOpts1: " ++ show ghcOpts1
            -- GhcMonad.liftIO $ putStrLn $ "ghcOpts2: " ++ show ghcOpts2

            -- FIXME Can probably remove the ghcOpts1 and ghcOpts2 stuff which
            -- is superceded by the functionality of getCompilerOptionsViaGhcMod.
            (dflags1, _, _) <- GHC.parseDynamicFlags dflags0 (map SrcLoc.noLoc $ ghcOpts1 ++ ghcOpts2 ++ ghcOpts0 ++ compGhcOpts)

            let dflags2 = dflags1 { hscTarget = HscInterpreted
                                  , ghcLink = LinkInMemory
                                  , importPaths = iPaths<commit_msg>Dump the full list of GHC options.<commit_after>{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GhcImportedFrom
-- Copyright   :  <NAME> 2013, 2014
-- License     :  BSD3
--
-- Maintainer  :  <EMAIL>
-- Stability   :  experimental
-- Portability :  portable
--
-- Synopsis: Attempt to guess the location of the Haddock HTML
-- documentation for a given symbol in a particular module, file, and
-- line/col location.
--
-- Latest development version: <https://github.com/carlohamalainen/ghc-imported-from>.

module Language.Haskell.GhcImportedFrom (
     QualifiedName(..)
   , Symbol(..)
   , GhcOptions(..)
   , GhcPkgOptions(..)
   , HaskellModule(..)
   , ghcOptionToGhcPKg
   , getGhcOptionsViaGhcMod
   , getGHCOptionsViaCradle
   , getCompilerOptionsViaGhcMod
   , modifyDFlags
   , setDynamicFlags
   , getTextualImports
   , getSummary
   , toHaskellModule
   , lookupSymbol
   , symbolImportedFrom
   , postfixMatch
   , moduleOfQualifiedName
   , qualifiedName
   , ghcPkgFindModule
   , ghcPkgHaddockUrl
   , moduleNameToHtmlFile
   , expandMatchingAsImport
   , specificallyMatches
   , toHackageUrl
   , bestPrefixMatches
   , findHaddockModule
   , matchToUrl
   , guessHaddockUrl
   , haddockUrl

   -- Things from Language.Haskell.GhcImportedFrom.Types
   , Options (..)
   , defaultOptions
   , LineSeparator (..)
   ) where

import Control.Applicative
import Control.Monad
import Control.Monad.Instances()
import Control.Monad.Writer
import Control.Monad.Trans as CMT
import Data.Function (on)
import Data.List
import Data.Maybe
import Data.Typeable()
import Desugar()
import DynFlags
import FastString
import GHC
import GHC.Paths (libdir)
import GHC.SYB.Utils()
import HscTypes
import Name
import Outputable
import RdrName
import System.Directory
import System.Environment()
import System.FilePath
import System.IO
import System.Process
import TcRnTypes()

import qualified DynFlags()
import qualified GhcMonad
import qualified MonadUtils()
import qualified Packages
import qualified SrcLoc
import qualified Safe

import Language.Haskell.GhcMod (
      findCradle
    , cradleCabalFile
    , cradleCabalDir
    , cradlePackageDbOpts
    )

import Language.Haskell.GhcMod.Internal (
    cabalAllBuildInfo
    , GHCOption
    , parseCabalFile
    , CompilerOptions (..)
    )

import Language.Haskell.GhcImportedFrom.UtilsFromGhcMod
import Language.Haskell.GhcImportedFrom.Types

type QualifiedName = String -- ^ A qualified name, e.g. @Foo.bar@.

type Symbol = String -- ^ A symbol, possibly qualified, e.g. @bar@ or @Foo.bar@.

newtype GhcOptions
    -- | List of user-supplied GHC options, refer to @tets@ subdirectory for example usage. Note that
    -- GHC API and ghc-pkg have inconsistencies in the naming of options, see <http://www.vex.net/~trebla/haskell/sicp.xhtml> for more details.
    = GhcOptions [String] deriving (Show)

newtype GhcPkgOptions
    -- | List of user-supplied ghc-pkg options.
    = GhcPkgOptions [String] deriving (Show)

data HaskellModule
    -- | Information about an import of a Haskell module.
    = HaskellModule { modName           :: String
                    , modQualifier      :: Maybe String
                    , modIsImplicit     :: Bool
                    , modHiding         :: [String]
                    , modImportedAs     :: Maybe String
                    , modSpecifically   :: [String]
                    } deriving (Show, Eq)

-- | Convert a GHC command line option to a @ghc-pkg@ command line option. This function
-- is incomplete; it only handles a few cases at the moment.
ghcOptionToGhcPKg :: [String] -> [String]
ghcOptionToGhcPKg [] = []
ghcOptionToGhcPKg (x:xs) = case x of "-no-user-package-db" -> "--no-user-package-db":ghcOptionToGhcPKg xs
                                     "-package-db"         -> ["--package-db", head xs] ++ ghcOptionToGhcPKg (tail xs)
                                     _                     -> error $ "Unknown GHC option: " ++ show (x:xs) -- FIXME Other cases?

-- | Use ghcmod's API to get the GHC options for a project. This uses 'findCradle', 'cradlePackageDbOpts', and 'GhcOptions'.
getGhcOptionsViaGhcMod :: IO GhcOptions
getGhcOptionsViaGhcMod = GhcOptions . cradlePackageDbOpts <$> findCradle

-- | Use ghcmod's API to get the GHC options for a project. This uses 'findCradle' and 'getGHCOptions.'
getGHCOptionsViaCradle :: IO [GHCOption]
getGHCOptionsViaCradle = do
    c <- findCradle
    pkgDesc <- GhcMonad.liftIO $ parseCabalFile $ fromJust $ cradleCabalFile c
    let binfo = head $ cabalAllBuildInfo pkgDesc
    getGHCOptions [] c (fromJust $ cradleCabalDir c) binfo

-- | Get compiler options using ghc-mod's API.
getCompilerOptionsViaGhcMod :: [GHCOption] -> IO CompilerOptions
getCompilerOptionsViaGhcMod ghcOpts0 = do
    cradle <- findCradle
    pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle
    getCompilerOptions ghcOpts0 cradle pkgDesc

-- | Add user-supplied GHC options to those discovered via ghc-mod.
modifyDFlags :: [String] -> DynFlags -> IO ([String], [GHCOption], DynFlags)
modifyDFlags ghcOpts0 dflags0 =
    defaultErrorHandler defaultFatalMessager defaultFlushOut $
        runGhc (Just libdir) $ do
            (GhcOptions ghcOpts1) <- GhcMonad.liftIO getGhcOptionsViaGhcMod
            ghcOpts2 <- GhcMonad.liftIO getGHCOptionsViaCradle

            (CompilerOptions compGhcOpts iPaths coDepPkgs) <- GhcMonad.liftIO $ getCompilerOptionsViaGhcMod ghcOpts0

            -- FIXME Need to log this info.
            -- GhcMonad.liftIO $ putStrLn $ "compGhcOpts: " ++ show compGhcOpts
            -- GhcMonad.liftIO $ putStrLn $ "iPaths: " ++ show iPaths
            -- GhcMonad.liftIO $ putStrLn $ "coDepPkgs: " ++ show coDepPkgs

            -- FIXME need to add ghcOpts1 and ghcOpts2 to the WriterT, but here
            -- we are inside the GhcMonad, so need to do some transformer stuff.
            -- Instead we laboriously return ghcOpts1 and ghcOpts2 up the call chain.
            -- GhcMonad.liftIO $ putStrLn $ "ghcOpts1: " ++ show ghcOpts1
            -- GhcMonad.liftIO $ putStrLn $ "ghcOpts2: " ++ show ghcOpts2

            -- FIXME Can probably remove the ghcOpts1 and ghcOpts2 stuff which
            -- is superceded by the functionality of getCompilerOptionsViaGhcMod.
            GhcMonad.liftIO $ putStrLn $ "modifyDFlags: " ++ (show $ ghcOpts1 ++ ghcOpts2 ++ ghcOpts0 ++ compGhcOpts)

            (dflags1, _, _) <- GHC.parseDynamicFlags dflags0 (map SrcLoc.noLoc $ ghcOpts1 ++ ghcOpts2 ++ ghcOpts0 ++ compGhcOpts)

            let dflags2 = dflags1 { hscTarget = HscInterpreted
                                  , ghcLink = LinkInMemory
                                  , importPaths = iPaths
{'fraction_non_alphanumeric': 0.10023584905660378, 'fraction_numerical': 0.005232900943396226, 'mean_word_length': 2.6456206340677055, 'pattern_counts': {'":': 2, '<': 29, '<?xml version=': 0, '>': 27, 'https://': 2, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 10, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2537123', 'n_tokens_mistral': 4473, 'n_tokens_neox': 4310, 'n_words': 1119}