hiedb-0.3.0.0: test/Main.hs
module Main where
import GHC.Paths (libdir)
import HieDb (HieDb, HieModuleRow (..), LibDir (..), ModuleInfo (..), withHieDb, withHieFile, addRefsFromLoaded, deleteMissingRealFiles)
import HieDb.Query (getAllIndexedMods, lookupHieFile, resolveUnitId, lookupHieFileFromSource)
import HieDb.Run (Command (..), Options (..), runCommand)
import HieDb.Types (HieDbErr (..), SourceFile(..), runDbM)
import HieDb.Utils (makeNc)
import Module (mkModuleName, moduleNameString, stringToUnitId)
import System.Directory (findExecutable, getCurrentDirectory, removeDirectoryRecursive)
import System.Exit (ExitCode (..), die)
import System.FilePath ((</>))
import System.Process (callProcess, proc, readCreateProcessWithExitCode)
import System.IO.Temp
import System.IO
import Test.Hspec (Expectation, Spec, afterAll_, around, beforeAll_, describe, hspec, it, runIO,
shouldBe, shouldEndWith)
import Test.Orphans ()
import GHC.Fingerprint
import Data.IORef
main :: IO ()
main = hspec spec
spec :: Spec
spec =
describe "hiedb" $
beforeAll_ compileTestModules $
afterAll_ cleanTestData $ do
cliSpec
apiSpec
apiSpec :: Spec
apiSpec = describe "api" $
beforeAll_ (runCommandTest (Index [testTmp])) $
around withTestDb $
describe "HieDb.Query" $ do
describe "getAllIndexedMods" $ do
it "returns all indexed modules" $ \conn -> do
mods <- getAllIndexedMods conn
case mods of
[m1,m2] -> do
moduleNameString (modInfoName (hieModInfo m1)) `shouldBe` "Sub.Module2"
moduleNameString (modInfoName (hieModInfo m2)) `shouldBe` "Module1"
xs -> fail $ "Was expecting 2 modules, but got " <> show (length xs)
describe "resolveUnitId" $ do
it "resolves unit when module unambiguous" $ \conn -> do
res <- resolveUnitId conn (mkModuleName "Module1")
case res of
Left e -> fail $ "Unexpected error: " <> show e
Right unitId -> unitId `shouldBe` stringToUnitId "main"
it "returns NotIndexed error on not-indexed module" $ \conn -> do
let notIndexedModule = mkModuleName "NotIndexed"
res <- resolveUnitId conn notIndexedModule
case res of
Left (NotIndexed modName Nothing) -> modName `shouldBe` notIndexedModule
Left e -> fail $ "Unexpected error: " <> show e
Right unitId -> fail $ "Unexpected success: " <> show unitId
describe "lookupHieFile" $ do
it "Should lookup indexed Module" $ \conn -> do
let modName = mkModuleName "Module1"
res <- lookupHieFile conn modName (stringToUnitId "main")
case res of
Just modRow -> do
hieModuleHieFile modRow `shouldEndWith` "Module1.hie"
let modInfo = hieModInfo modRow
modInfoIsReal modInfo `shouldBe` False
modInfoName modInfo `shouldBe` modName
Nothing -> fail "Should have looked up indexed file"
it "Should return Nothing for not indexed Module" $ \conn -> do
res <- lookupHieFile conn (mkModuleName "NotIndexed") (stringToUnitId "main")
case res of
Nothing -> pure ()
Just _ -> fail "Lookup suceeded unexpectedly"
describe "deleteMissingRealFiles" $ do
it "Should delete missing indexed files and nothing else" $ \conn -> do
originalMods <- getAllIndexedMods conn
-- Index a new real file, and delete it
let contents = unlines
[ "module Test123 where"
, "foobarbaz :: Int"
, "foobarbaz = 1"
]
fp <- withSystemTempFile "Test.hs" $ \fp h -> do
hPutStr h contents
hClose h
callProcess "ghc" $
"-fno-code" : -- don't produce unnecessary .o and .hi files
"-fwrite-ide-info" :
"-hiedir=" <> testTmp :
[fp]
let hie_f = testTmp </> "Test123.hie"
hash <- getFileHash hie_f
nc <- newIORef =<< makeNc
runDbM nc $ withHieFile hie_f $
addRefsFromLoaded conn hie_f (RealFile fp) hash
pure fp
-- Check that it was indexed
before <- lookupHieFileFromSource conn fp
case before of
Nothing -> fail $ "File "<> show fp <> "wasn't indexed"
Just _ -> pure ()
deleteMissingRealFiles conn
-- Check that it was deleted from the db
after <- lookupHieFileFromSource conn fp
case after of
Nothing -> pure ()
Just _ -> fail $ "deleteMissingRealFiles didn't delete file: " <> show fp
-- Check that the other modules are still indexed
afterMods <- getAllIndexedMods conn
originalMods `shouldBe` afterMods
cliSpec :: Spec
cliSpec =
-- TODO commands not covered: init, type-refs, ref-graph, dump, reachable, unreachable, html
describe "Command line" $ do
describe "index" $
it "indexes testing project .hie files" $ do
runHieDbCli ["index", testTmp, "--quiet"]
`suceedsWithStdin` ""
describe "ls" $
it "lists the indexed modules" $ do
cwd <- getCurrentDirectory
let expectedOutput = unlines (fmap (\x -> cwd </> testTmp </> x)
[ "Sub/Module2.hie\tSub.Module2\tmain"
, "Module1.hie\tModule1\tmain"
])
runHieDbCli ["ls"] `suceedsWithStdin` expectedOutput
describe "name-refs" $
it "lists all references of given function" $ do
runHieDbCli ["name-refs", "function2"]
`suceedsWithStdin` unlines
[ "Module1:3:7-3:16"
, "Module1:12:1-12:10"
, "Module1:13:1-13:10"
]
describe "point-refs" $
it "list references at given point" $
runHieDbCli ["point-refs", "Module1", "13", "2"]
`suceedsWithStdin` unlines
[ "Module1:3:7-3:16"
, "Module1:12:1-12:10"
, "Module1:13:1-13:10"
]
describe "point-types" $ do
it "Prints types of symbol under cursor" $
runHieDbCli ["point-types", "Module1", "10", "10" ]
`suceedsWithStdin` unlines
[ "Int -> Bool" {- types of `even` function under cursor -}
, "forall a. Integral a => a -> Bool"
]
it "Fails for symbols that don't have type associated" $ do
(exitCode, actualStdout, actualStderr) <- runHieDbCli ["point-types", "Module1", "8", "21"]
actualStdout `shouldBe` ""
exitCode `shouldBe` ExitFailure 1
actualStderr `shouldBe` "No symbols found at (8,21) in Module1\n"
describe "point-defs" $ do
it "outputs the location of symbol when definition site can be found is indexed" $
runHieDbCli ["point-defs", "Module1", "13", "29"]
`suceedsWithStdin` unlines
[ "Sub.Module2:7:1-7:8"
]
it "Fails with informative error message when there's no symbol at given point" $ do
(exitCode, actualStdout, actualStderr) <- runHieDbCli ["point-defs", "Module1", "13", "13"]
actualStdout `shouldBe` ""
exitCode `shouldBe` ExitFailure 1
actualStderr `shouldBe` "No symbols found at (13,13) in Module1\n"
it "fails with informative error message when the difinition can't be found" $ do
(exitCode, actualStdout, actualStderr) <- runHieDbCli ["point-defs", "Module1", "13", "24"]
actualStdout `shouldBe` ""
exitCode `shouldBe` ExitFailure 1
actualStderr `shouldBe` "Couldn't find name: $ from module GHC.Base(base)\n"
describe "point-info" $ do
it "gives information about symbol at specified location" $
runHieDbCli ["point-info", "Sub.Module2", "10", "10"]
`suceedsWithStdin` unlines
[ "Span: test/data/Sub/Module2.hs:10:7-23"
, "Constructors: {(ConDeclH98, ConDecl)}"
, "Identifiers:"
, "Symbol:c:Data1Constructor1:Sub.Module2:main"
, "Data1Constructor1 defined at test/data/Sub/Module2.hs:10:7-23"
, " IdentifierDetails Nothing {Decl ConDec (Just SrcSpanOneLine \"test/data/Sub/Module2.hs\" 10 7 24)}"
, "Types:\n"
]
it "correctly prints type signatures" $
runHieDbCli ["point-info", "Module1", "10", "10"]
`suceedsWithStdin` unlines
[ "Span: test/data/Module1.hs:10:8-11"
, "Constructors: {(HsVar, HsExpr), (HsWrap, HsExpr)}"
, "Identifiers:"
, "Symbol:v:even:GHC.Real:base"
, "even defined at <no location info>"
, " IdentifierDetails Just forall a. Integral a => a -> Bool {Use}"
, "Types:"
, "Int -> Bool"
, "forall a. Integral a => a -> Bool"
, ""
]
describe "name-def" $
it "lookup definition of name" $
runHieDbCli ["name-def", "showInt"]
`suceedsWithStdin` "Sub.Module2:7:1-7:8\n"
describe "type-def" $
it "lookup definition of type" $
runHieDbCli ["type-def", "Data1"]
`suceedsWithStdin` "Sub.Module2:9:1-11:28\n"
describe "cat" $
describe "dumps module source stored in .hie file" $ do
module1Src <- runIO . readFile $ "test" </> "data" </> "Module1.hs"
it "when given --hiefile" $ do
cwd <- getCurrentDirectory
runHieDbCli ["cat", "--hiefile" , cwd </> testTmp </> "Module1.hie"]
`suceedsWithStdin` (module1Src <> "\n")
it "when given module name" $
runHieDbCli ["cat", "Module1"]
`suceedsWithStdin` (module1Src <> "\n")
describe "lookup-hie" $
it "looks up location of .hie file" $ do
cwd <- getCurrentDirectory
runHieDbCli ["lookup-hie", "Module1"]
`suceedsWithStdin` (cwd </> testTmp </> "Module1.hie\n")
describe "module-uids" $
it "lists uids for given module" $
runHieDbCli ["module-uids", "Module1"]
`suceedsWithStdin` "main\n"
describe "rm" $
it "removes given module from DB" $ do
runHieDbCli ["rm", "Module1"]
`suceedsWithStdin` ""
-- Check with 'ls' comand that there's just one module left
cwd <- getCurrentDirectory
runHieDbCli ["ls"] `suceedsWithStdin` (cwd </> testTmp </> "Sub/Module2.hie\tSub.Module2\tmain\n")
suceedsWithStdin :: IO (ExitCode, String, String) -> String -> Expectation
suceedsWithStdin action expectedStdin = do
(exitCode, actualStdin, _actualStdErr) <- action
exitCode `shouldBe` ExitSuccess
actualStdin `shouldBe` expectedStdin
runHieDbCli :: [String] -> IO (ExitCode, String, String)
runHieDbCli args = do
hiedb <- findHieDbExecutable
let argsWithTestDb = "--database" : testDb : args
let createProc = proc hiedb argsWithTestDb
putStrLn $ unwords $ "RUNNING: hiedb" : argsWithTestDb
readCreateProcessWithExitCode createProc ""
findHieDbExecutable :: IO FilePath
findHieDbExecutable =
maybe (die "Did not find hiedb executable") pure =<< findExecutable "hiedb"
cleanTestData :: IO ()
cleanTestData = removeDirectoryRecursive testTmp
compileTestModules :: IO ()
compileTestModules =
callProcess "ghc" $
"-fno-code" : -- don't produce unnecessary .o and .hi files
"-fwrite-ide-info" :
"-hiedir=" <> testTmp :
testModules
testModules :: [FilePath]
testModules = fmap (\m -> "test" </> "data"</> m)
[ "Module1.hs"
, "Sub" </> "Module2.hs"
]
testDb :: FilePath
testDb = testTmp </> "test.hiedb"
testTmp :: FilePath
testTmp = "test" </> "tmp"
withTestDb :: (HieDb -> IO a) -> IO a
withTestDb = withHieDb testDb
runCommandTest :: Command -> IO ()
runCommandTest = runCommand (LibDir libdir) testOpts
testOpts :: Options
testOpts = Options
{ database = testDb
, trace = False
, quiet = True
, colour = False
, context = Nothing
, reindex = False
, keepMissing = False
}