packages feed

mcp-hoogle-0.2.0: test/Test.hs

module Main where

import Test.Tasty
import Test.Tasty.HUnit

import Control.Concurrent.STM (TVar, newTVarIO, atomically, writeTVar)
import Data.Time.Clock (getCurrentTime)
import Control.Exception (try, SomeException)
import Data.IORef (IORef, newIORef)
import Data.Text qualified as Text
import Hoogle (Database, Target(..), defaultDatabaseLocation, withDatabase, hoogle)
import McpHoogle.Format (formatTarget, formatTargets, stripHtmlTags)
import McpHoogle.Tools (HoogleTool(..), SearchParams(..), SearchTypeParams(..), LookupModuleParams(..), RegenState(..), handleTool)
import System.Directory (doesFileExist, createDirectoryIfMissing, getTemporaryDirectory)

main :: IO ()
main = defaultMain tests

tests :: TestTree
tests = testGroup "McpHoogle"
  [ formatTests
  , stripHtmlTests
  , regenStateTests
  , withResource acquireDb releaseDb hoogleSearchTests
  ]

-- | Acquire a hoogle database for testing.
-- Uses the default location if it exists, otherwise generates a fresh one.
-- Returns Nothing if generation fails (e.g. no haddock docs in CI).
acquireDb :: IO (Maybe FilePath)
acquireDb = do
  defaultPath <- defaultDatabaseLocation
  dbExists <- doesFileExist defaultPath
  if dbExists
    then pure (Just defaultPath)
    else do
      tmpDir <- getTemporaryDirectory
      let testDbDir = tmpDir <> "/mcp-hoogle-test"
          testDbPath = testDbDir <> "/test.hoo"
      createDirectoryIfMissing True testDbDir
      result <- try (hoogle ["generate", "--local", "--database=" <> testDbPath]) :: IO (Either SomeException ())
      case result of
        Right () -> do
          generated <- doesFileExist testDbPath
          pure (if generated then Just testDbPath else Nothing)
        Left _ -> pure Nothing

-- | No-op cleanup (temp files are fine to leave)
releaseDb :: Maybe FilePath -> IO ()
releaseDb _ = pure ()

formatTests :: TestTree
formatTests = testGroup "Format"
  [ testCase "formatTargets empty returns no results message" $
      formatTargets [] @?= "No results found."
  , testCase "formatTarget includes package name" $ do
      let target = mkTarget "map" (Just ("containers", "")) (Just ("Data.Map", ""))
          result = formatTarget target
      assertBool "should contain package name" (Text.isInfixOf "containers" result)
  , testCase "formatTarget includes module name" $ do
      let target = mkTarget "map" (Just ("containers", "")) (Just ("Data.Map", ""))
          result = formatTarget target
      assertBool "should contain module name" (Text.isInfixOf "Data.Map" result)
  , testCase "formatTarget includes function name" $ do
      let target = mkTarget "<s0>map</s0> :: (a -> b) -> [a] -> [b]" Nothing Nothing
          result = formatTarget target
      assertBool "should contain function name after stripping html" (Text.isInfixOf "map" result)
  ]

stripHtmlTests :: TestTree
stripHtmlTests = testGroup "stripHtmlTags"
  [ testCase "strips simple tags" $
      stripHtmlTags "<b>hello</b>" @?= "hello"
  , testCase "strips span tags from hoogle output" $
      stripHtmlTags "<span class=name><s0>map</s0></span> :: (a -> b) -> [a] -> [b]"
        @?= "map :: (a -> b) -> [a] -> [b]"
  , testCase "preserves plain text" $
      stripHtmlTags "no tags here" @?= "no tags here"
  , testCase "handles nested tags" $
      stripHtmlTags "<a><b>deep</b></a>" @?= "deep"
  ]

-- | Tests for the async regeneration state machine.
regenStateTests :: TestTree
regenStateTests = testGroup "Regeneration state"
  [ testCase "regeneration_status reports idle initially" $ do
      databaseRef <- newIORef Nothing
      regenStateVar <- newTVarIO RegenIdle
      result <- handleTool databaseRef regenStateVar RegenerationStatus
      assertBool "should report idle"
        (Text.isInfixOf "No regeneration" result)
  , testCase "regeneration_status reports running when state is RegenRunning" $ do
      databaseRef <- newIORef Nothing
      regenStateVar <- newTVarIO RegenIdle
      now <- getCurrentTime
      atomically (writeTVar regenStateVar (RegenRunning now))
      result <- handleTool databaseRef regenStateVar RegenerationStatus
      assertBool "should report in progress"
        (Text.isInfixOf "in progress" result)
  , testCase "regeneration_status reports failure" $ do
      databaseRef <- newIORef Nothing
      regenStateVar <- newTVarIO RegenIdle
      now <- getCurrentTime
      atomically (writeTVar regenStateVar (RegenFailed now "ghc-pkg not found"))
      result <- handleTool databaseRef regenStateVar RegenerationStatus
      assertBool "should report failure with error message"
        (Text.isInfixOf "ghc-pkg not found" result)
  , testCase "regeneration_status reports completion" $ do
      databaseRef <- newIORef Nothing
      regenStateVar <- newTVarIO RegenIdle
      now <- getCurrentTime
      atomically (writeTVar regenStateVar (RegenDone now "/tmp/test.hoo"))
      result <- handleTool databaseRef regenStateVar RegenerationStatus
      assertBool "should report completed with path"
        (Text.isInfixOf "/tmp/test.hoo" result)
  ]

-- | Integration tests that exercise hoogle search through our handler.
-- The database path is shared across all tests via withResource.
-- Tests pass trivially when no database is available (e.g. cabal CI without haddocks).
hoogleSearchTests :: IO (Maybe FilePath) -> TestTree
hoogleSearchTests getDbPath = testGroup "Hoogle search integration"
  [ testCase "search for 'map' returns results" $ do
      mDbPath <- getDbPath
      case mDbPath of
        Nothing -> pure () -- no DB available, skip
        Just dbPath -> withHoogleDb dbPath $ \databaseRef regenStateVar -> do
          result <- handleTool databaseRef regenStateVar (Search (SearchParams "map"))
          assertBool "search should return results, not 'No results found'"
            (result /= "No results found.")
          assertBool "search for map should mention 'map' in results"
            (Text.isInfixOf "map" result)
  , testCase "type search '[a] -> Int' returns results" $ do
      mDbPath <- getDbPath
      case mDbPath of
        Nothing -> pure ()
        Just dbPath -> withHoogleDb dbPath $ \databaseRef regenStateVar -> do
          result <- handleTool databaseRef regenStateVar (SearchType (SearchTypeParams "[a] -> Int"))
          assertBool "type search should return results"
            (result /= "No results found.")
  , testCase "module lookup 'Data.Map' returns results" $ do
      mDbPath <- getDbPath
      case mDbPath of
        Nothing -> pure ()
        Just dbPath -> withHoogleDb dbPath $ \databaseRef regenStateVar -> do
          result <- handleTool databaseRef regenStateVar (LookupModule (LookupModuleParams "Data.Map"))
          assertBool "module lookup should return results"
            (result /= "No results found.")
  ]

-- | Load a hoogle database and run an action with it
withHoogleDb :: FilePath -> (IORef (Maybe Database) -> TVar RegenState -> IO ()) -> IO ()
withHoogleDb path action =
  withDatabase path $ \database -> do
    databaseRef <- newIORef (Just database)
    regenStateVar <- newTVarIO RegenIdle
    action databaseRef regenStateVar

-- | Helper to create a Target for testing
mkTarget :: String -> Maybe (String, String) -> Maybe (String, String) -> Target
mkTarget item package moduleDef = Target
  { targetURL = "https://hackage.haskell.org/example"
  , targetPackage = package
  , targetModule = moduleDef
  , targetType = ""
  , targetItem = item
  , targetDocs = ""
  }