Merge ghc-imported-from into ghc-mod

Language/Haskell/GhcMod/Pretty.hs

@@ -32,8 +32,7 @@ gmRenderDoc = renderStyle docStyle
 
 gmComponentNameDoc :: ChComponentName -> Doc
 gmComponentNameDoc ChSetupHsName   = text $ "Setup.hs"
-gmComponentNameDoc (ChLibName "")  = text $ "library"
-gmComponentNameDoc (ChLibName n)   = text $ "library:" ++ n
+gmComponentNameDoc ChLibName       = text $ "library"
 gmComponentNameDoc (ChExeName n)   = text $ "exe:" ++ n
 gmComponentNameDoc (ChTestName n)  = text $ "test:" ++ n
 gmComponentNameDoc (ChBenchName n) = text $ "bench:" ++ n

ghc-mod.cabal

@@ -134,6 +134,7 @@ Library
                         Language.Haskell.GhcMod.Flag
                         Language.Haskell.GhcMod.Gap
                         Language.Haskell.GhcMod.GhcPkg
+                        Language.Haskell.GhcMod.ImportedFrom
                         Language.Haskell.GhcMod.HomeModuleGraph
                         Language.Haskell.GhcMod.Info
                         Language.Haskell.GhcMod.Lang
@@ -174,9 +175,10 @@ Library
                       , bytestring        < 0.11
                       , binary            < 0.9 && >= 0.5.1.0
                       , containers        < 0.6
-                      , cabal-helper      < 0.8 && >= 0.7.1.0
+                      , cabal-helper
                       , deepseq           < 1.5
                       , directory         < 1.3
+                      , exceptions
                       , filepath          < 1.5
                       , ghc               < 8.2 && >= 7.6
                       , ghc-paths         < 0.2
@@ -193,6 +195,9 @@ Library
                       , transformers-base < 0.5
                       , mtl               < 2.3 && >= 2.0
                       , monad-control     < 1.1 && >= 1
+                      , parsec
+                      , process
+                      , process-streaming
                       , split             < 0.3
                       , haskell-src-exts  < 1.18
                       , text              < 1.3
@@ -209,6 +214,12 @@ Library
   if impl(ghc >= 8.0)
     Build-Depends:      ghc-boot
 
+  if impl(ghc >= 8.0)
+    Build-Depends:      haddock-api >= 2.17.2
+
+  if impl(ghc >=7.10 && < 7.12)
+    Build-Depends:      haddock-api <= 2.16.1
+
 Executable ghc-mod
   Default-Language:     Haskell2010
   Main-Is:              GHCMod.hs

src/GHCMod.hs

@@ -13,6 +13,7 @@ import Language.Haskell.GhcMod.Internal hiding (MonadIO,liftIO)
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Find (AsyncSymbolDb, newAsyncSymbolDb, getAsyncSymbolDb)
+import Language.Haskell.GhcMod.ImportedFrom (importedFrom)
 import System.FilePath ((</>))
 import System.Directory (setCurrentDirectory, getAppUserDataDirectory,
                         removeDirectoryRecursive)
@@ -150,6 +151,7 @@ ghcCommands (CmdLint opts file) = lint opts file
 ghcCommands (CmdBrowse opts ms) = concat <$> browse opts `mapM` ms
 ghcCommands (CmdCheck files) = checkSyntax files
 ghcCommands (CmdExpand files) = expandTemplate files
+ghcCommands (CmdImportedFrom file (line, col) symb) = importedFrom file line col $ Expression symb
 ghcCommands (CmdInfo file symb) = info file $ Expression symb
 ghcCommands (CmdType wCon file (line, col)) = types wCon file line col
 ghcCommands (CmdSplit file (line, col)) = splits file line col

src/GHCMod/Options/Commands.hs

@@ -50,6 +50,7 @@ data GhcModCommands =
   | CmdDebugComponent [String]
   | CmdCheck [FilePath]
   | CmdExpand [FilePath]
+  | CmdImportedFrom FilePath Point Expr
   | CmdInfo FilePath Symbol
   | CmdType Bool FilePath Point
   | CmdSplit FilePath Point
@@ -133,6 +134,9 @@ commands =
     <> command "expand"
           $$  info expandArgSpec
           $$  progDesc "Like `check' but also pass `-ddump-splices' to GHC"
+    <> command "imported-from"
+          $$  info importedFromArgSpec
+          $$  progDesc "Get the Haddock URL of the expression under (LINE,COL)"
     <> command "info"
           $$  info infoArgSpec
           $$  progDesc' $$$ do
@@ -228,7 +232,7 @@ locArgSpec x = x
 
 modulesArgSpec, docArgSpec, findArgSpec,
   lintArgSpec, browseArgSpec, checkArgSpec, expandArgSpec,
-  infoArgSpec, typeArgSpec, autoArgSpec, splitArgSpec,
+  importedFromArgSpec, infoArgSpec, typeArgSpec, autoArgSpec, splitArgSpec,
   sigArgSpec, refineArgSpec, debugComponentArgSpec,
   mapArgSpec, unmapArgSpec, legacyInteractiveArgSpec :: Parser GhcModCommands
 
@@ -268,6 +272,7 @@ browseArgSpec = CmdBrowse
 debugComponentArgSpec = filesArgsSpec (pure CmdDebugComponent)
 checkArgSpec = filesArgsSpec (pure CmdCheck)
 expandArgSpec = filesArgsSpec (pure CmdExpand)
+importedFromArgSpec = locArgSpec (pure CmdImportedFrom) <*> strArg "SYMBOL"
 infoArgSpec = CmdInfo
     <$> strArg "FILE"
     <*> strArg "SYMBOL"

test/ImportedFromSpec.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE CPP #-}
+module ImportedFromSpec where
+
+import Control.Applicative
+import Language.Haskell.GhcMod
+import System.FilePath
+import Test.Hspec
+import TestUtils
+import Prelude
+
+import Language.Haskell.GhcMod.Utils
+
+---------------------------------------------------
+import Language.Haskell.GhcMod.ImportedFrom
+import System.FilePath()
+import Test.Hspec
+
+import Control.Exception as E
+import System.Directory
+---------------------------------------------------
+
+isRight :: forall a b. Either a b -> Bool
+isRight = either (const False) (const True)
+
+spec :: Spec
+spec = do
+    describe "checkImportedFrom" $ do
+        it "can look up Maybe" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom01.hs" 11 11 (Expression "Maybe")
+                res `shouldSatisfy` isRight
+
+        it "can look up Just" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom01.hs" 12 7  (Expression "Just")
+                res `shouldSatisfy` isRight
+
+        it "can look up Just" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom01.hs" 16 10 (Expression "Just")
+                res `shouldSatisfy` isRight
+
+        it "can look up String" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom01.hs" 20 14 (Expression "String")
+                res `shouldSatisfy` isRight
+
+        it "can look up Int" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom01.hs" 22 23 (Expression "Int")
+                res `shouldSatisfy` isRight
+
+        it "can look up DL.length" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom01.hs" 23 5  (Expression "DL.length")
+                res `shouldSatisfy` isRight
+
+        it "can look up print" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom01.hs" 25 8  (Expression "print")
+                res `shouldSatisfy` isRight
+
+        it "can look up DM.fromList" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom01.hs" 27 5  (Expression "DM.fromList")
+                res `shouldSatisfy` isRight
+
+        it "can look up Safe.headMay" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom01.hs" 29 6  (Expression "Safe.headMay")
+                res `shouldSatisfy` isRight
+
+        it "can look up Foo.Bar.length" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom01.hs" 34 17 (Expression "Foo.Bar.length")
+                res `shouldSatisfy` isRight
+
+        it "can look up map" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom02.hs" 14 5  (Expression "map")
+                res `shouldSatisfy` isRight
+
+        it "can look up head" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom02.hs" 16 5  (Expression "head")
+                res `shouldSatisfy` isRight
+
+        it "can look up when" $ do
+            withDirectory_ "test/data/imported-from" $ do
+                (res, _) <- runGmOutDef $ runGhcModT defaultOptions $ importedFrom "ImportedFrom03.hs"   15 5  (Expression "when")
+                res `shouldSatisfy` isRight

test/data/imported-from/ImportedFrom01.hs

@@ -0,0 +1,34 @@
+-- ImportedFrom01.hs
+
+module ImportedFrom01 where
+
+import Data.Maybe
+import qualified Data.List as DL
+import qualified Data.Map as DM
+import qualified Safe
+import qualified Data.List as Foo.Bar
+
+f :: a -> Maybe a
+f x = Just x
+
+g :: IO ()
+g = do
+    let (Just _, _) = (Just 3, Just 4)
+
+    return ()
+
+s = "boo" :: String
+s' = head s
+t = Just 100 :: Maybe Int
+r = DL.length [1, 2, 3]
+
+main = print "Hello, World!"
+
+h = DM.fromList [("x", "y")]
+
+sh = Safe.headMay []
+
+i = 3 :: Int
+i' = 3 :: Integer
+
+len = Foo.Bar.length

test/data/imported-from/ImportedFrom02.hs

@@ -0,0 +1,19 @@
+-- ImportedFrom02.hs
+
+module ImportedFrom02 where
+
+import Data.List hiding (map)
+import System.Environment (getArgs)
+import qualified Safe
+
+
+
+
+
+
+m = map (+1) [1, 2, 3]
+
+h = head [1, 2, 3]
+
+h' = Safe.headMay []
+

test/data/imported-from/ImportedFrom03.hs

@@ -0,0 +1,15 @@
+-- ImportedFrom03.hs
+
+module ImportedFrom03 where
+
+import Control.Monad ( forM_, liftM, filterM, when, unless )
+import Control.Monad.Identity
+import Control.Monad.Reader
+import Control.Monad.Trans.Writer.Lazy
+
+
+
+
+
+main = do
+    when True $ do print "hah"