Discover.hs

-- | Tool discovery - finding synapse and service-codegen executables
module SynapseCC.Discover
  ( discoverTools
  , findTool
  , toolPathToFilePath
  , findInDistNewstyle
  , serviceCodegenSendsInjectedParams
  , findServiceCodegen
  , serviceCodegenName
  , oldCodegenName
  ) where

import Control.Exception (catch, SomeException, try)
import System.Exit (ExitCode)
import Control.Monad (forM, when)
import Data.List (sortBy, maximumBy)
import Data.Maybe (catMaybes)
import Data.Ord (comparing, Down(..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Read as TR
import System.Directory (doesFileExist, doesDirectoryExist, findExecutable, getHomeDirectory, listDirectory, getModificationTime)
import System.FilePath ((</>))
import System.Process (readProcessWithExitCode)

import SynapseCC.Logging (logDebug, logInfo)
import SynapseCC.Types

-- ============================================================================
-- Tool Discovery
-- ============================================================================

-- | Discover all required tools, respecting any explicit paths in Options
discoverTools :: Options -> IO (Either SynapseCCError ToolLocations)
discoverTools opts = do
  let debug = optDebug opts

  synapsePath <- case optSynapsePath opts of
    Just explicit -> resolveExplicit "synapse" explicit debug
    Nothing       -> findTool debug "synapse" synapseFallbackPaths

  case synapsePath of
    Nothing -> pure $ Left $ ToolNotFound "synapse" synapseSuggestions
    Just synapseToolPath -> do
      serviceCodegenPath <- case optServiceCodegenPath opts of
        Just explicit -> resolveExplicit serviceCodegenName explicit debug
        Nothing       -> findServiceCodegen debug >>= \case
          Nothing             -> pure Nothing
          Just (path, mNote)  -> mapM_ logInfo mNote >> pure (Just path)

      case serviceCodegenPath of
        Nothing -> pure $ Left $ ToolNotFound (T.pack serviceCodegenName) serviceCodegenSuggestions
        Just serviceCodegenToolPath -> do
          -- Run --version for each discovered tool
          synapseVer    <- getToolVersion (toolPathToFilePath synapseToolPath)
          serviceCodegenVer <- getToolVersion (toolPathToFilePath serviceCodegenToolPath)

          logDebug debug $ "  synapse     " <> T.pack (toolPathToFilePath synapseToolPath) <> "  (" <> synapseVer <> ")"
          logDebug debug $ "  service-codegen " <> T.pack (toolPathToFilePath serviceCodegenToolPath) <> "  (" <> serviceCodegenVer <> ")"
          when (serviceCodegenSendsInjectedParams serviceCodegenVer) $
            logInfo $ "the code generator " <> serviceCodegenVer <> " predates 0.5.0: a parameter the server injects "
              <> "(pdSource: auth, header, derived, …) comes out as an optional `unknown` argument "
              <> "of the generated methods. Use service-codegen 0.5.0 or later (SYNAPSE-CC-2)."

          pure $ Right $ ToolLocations
            { toolSynapse           = synapseToolPath
            , toolServiceCodegen        = serviceCodegenToolPath
            , toolSynapseVersion    = synapseVer
            , toolServiceCodegenVersion = serviceCodegenVer
            }

-- | SYNAPSE-CC-2: whether a service-codegen of this version (as 'getToolVersion'
-- reports it) still writes server-injected parameters into the generated
-- methods — every release before 0.5.0. An unparseable version is given
-- the benefit of the doubt.
serviceCodegenSendsInjectedParams :: Text -> Bool
serviceCodegenSendsInjectedParams ver =
  case traverse readNat (T.splitOn "." (T.takeWhile (/= '-') ver)) of
    Just (major : minor : _) -> (major, minor) < (0, 5)
    _                        -> False
  where
    readNat t = case TR.decimal t of
      Right (n, rest) | T.null rest -> Just (n :: Int)
      _                             -> Nothing

-- | Resolve an explicitly-provided path, failing clearly if it doesn't exist
resolveExplicit :: String -> FilePath -> Bool -> IO (Maybe ToolPath)
resolveExplicit name path debug = do
  exists <- doesFileExist path
  if exists
    then pure $ Just $ classifyPath path
    else do
      logDebug debug $ "  [!] " <> T.pack name <> ": explicit path not found: " <> T.pack path
      pure Nothing

-- | Find a tool: check PATH first, then fallback paths
findTool :: Bool -> String -> IO [FilePath] -> IO (Maybe ToolPath)
findTool debug name fallbacksIO = do
  -- Check PATH first (i.e. `which <name>`)
  mbWhich <- findExecutable name
  case mbWhich of
    Just path -> do
      logDebug debug $ "  " <> T.pack name <> ": found via PATH at " <> T.pack path
      pure $ Just $ SystemPath path
    Nothing -> do
      logDebug debug $ "  " <> T.pack name <> ": not in PATH, searching fallback locations..."
      paths <- fallbacksIO
      tryPaths paths
  where
    tryPaths [] = pure Nothing
    tryPaths (path:rest) = do
      exists <- doesFileExist path
      if exists
        then do
          logDebug debug $ "    Found: " <> T.pack path
          pure $ Just $ classifyPath path
        else tryPaths rest

-- | Classify a path based on where it was found
classifyPath :: FilePath -> ToolPath
classifyPath path
  | "dist-newstyle" `elem` splitPath path = LocalDev path
  | "target"        `elem` splitPath path = LocalDev path
  | ".plexus/bin"   `elem` splitPath path = PlexusBin path
  | otherwise                             = SystemPath path
  where
    splitPath = filter (not . null) . wordsBy (== '/')
    wordsBy p s = case dropWhile p s of
      [] -> []
      s' -> let (w, s'') = break p s' in w : wordsBy p s''

-- | Convert ToolPath to FilePath
toolPathToFilePath :: ToolPath -> FilePath
toolPathToFilePath = \case
  LocalDev path   -> path
  SystemPath path -> path
  PlexusBin path  -> path

-- | Run a tool with @--version@ and return the version string.
-- Strips a leading "v" and takes only the first line.
-- Returns @"unknown"@ if the call fails for any reason.
getToolVersion :: FilePath -> IO Text
getToolVersion exe = do
  result <- try (readProcessWithExitCode exe ["--version"] "") :: IO (Either SomeException (ExitCode, String, String))
  case result of
    Left _             -> pure "unknown"
    Right (_, out, _) ->
      let firstLine = T.strip $ T.pack $ head (lines out ++ [""])
          -- Take last word (handles "service-codegen 0.1.0" and "3.5.0")
          lastWord  = case reverse (T.words firstLine) of
                        (w:_) -> w
                        []    -> ""
          ver = case T.unpack lastWord of
                  ('v':rest) -> T.pack rest
                  _          -> lastWord
      in pure $ if T.null ver then "unknown" else ver

-- ============================================================================
-- dist-newstyle Glob Search
-- ============================================================================

-- | Search dist-newstyle for a built executable, returning the most recently
-- modified match (newest build wins).
--
-- Walks the pattern:
--   <root>/dist-newstyle/build/*\/ghc-*\/<pkg>-*\/x\/<exe>\/build\/<exe>\/<exe>
findInDistNewstyle :: FilePath  -- ^ project root (e.g. "../synapse")
                   -> String    -- ^ executable name (e.g. "synapse")
                   -> IO (Maybe FilePath)
findInDistNewstyle root exe = do
  let buildDir = root </> "dist-newstyle" </> "build"
  exists <- doesDirectoryExist buildDir
  if not exists
    then pure Nothing
    else do
      -- Level 1: arch dirs (e.g. aarch64-linux, x86_64-darwin)
      archDirs <- safeListDirectory buildDir
      candidates <- fmap concat $ forM archDirs $ \arch -> do
        let archPath = buildDir </> arch
        isDir <- doesDirectoryExist archPath
        if not isDir then pure [] else do

          -- Level 2: ghc-* dirs
          ghcDirs <- safeListDirectory archPath
          fmap concat $ forM ghcDirs $ \ghcDir -> do
            if not ("ghc-" `isPrefixOfStr` ghcDir) then pure [] else do
              let ghcPath = archPath </> ghcDir

              -- Level 3: <pkg>-* dirs
              pkgDirs <- safeListDirectory ghcPath
              fmap concat $ forM pkgDirs $ \pkgDir -> do
                let pkgPath = ghcPath </> pkgDir
                isDir2 <- doesDirectoryExist pkgPath
                if not isDir2 then pure [] else do

                  -- Level 4: x/<exe>/build/<exe>/<exe>
                  let candidate = pkgPath </> "x" </> exe </> "build" </> exe </> exe
                  exists2 <- doesFileExist candidate
                  if exists2 then pure [candidate] else pure []

      case candidates of
        []  -> pure Nothing
        [c] -> pure $ Just c
        cs  -> do
          -- Pick the most recently modified binary
          withTimes <- forM cs $ \c -> do
            t <- getModificationTime c
            pure (t, c)
          pure $ Just $ snd $ maximumBy (comparing fst) withTimes
  where
    isPrefixOfStr prefix str = take (length prefix) str == prefix

    safeListDirectory dir =
      listDirectory dir `catch` \(_ :: SomeException) -> pure []

-- ============================================================================
-- Fallback Search Paths (used only when not found in PATH)
-- ============================================================================

-- | Fallback paths for synapse (checked if not in PATH).
-- Uses glob-based dist-newstyle search to handle any arch/GHC version.
synapseFallbackPaths :: IO [FilePath]
synapseFallbackPaths = do
  home <- getHomeDirectory
  -- Search dist-newstyle trees relative to common project layouts
  mb1 <- findInDistNewstyle "../synapse" "synapse"
  mb2 <- findInDistNewstyle "../../synapse" "synapse"
  let devPaths = catMaybes [mb1, mb2]
  let installPaths =
        [ home </> ".plexus/bin/synapse"
        , home </> ".local/bin/synapse"
        , home </> ".cabal/bin/synapse"
        ]
  pure $ devPaths ++ installPaths

-- | NAMING-10: the generator is service-codegen; before 0.5.1 it had another
-- name. Discovery looks for the new name first — on PATH, then beside this
-- checkout and in the install directories — and only then for the old one.
serviceCodegenName :: String
serviceCodegenName = "service-codegen"

-- | The generator's name before NAMING-10, still found (second, with a note)
-- for one release.
oldCodegenName :: String
oldCodegenName = "hub-codegen" -- naming-alias: found after service-codegen; removed by NAMING-18

-- | Find the generator under its name, else under its old one. The second
-- part is a note to log when only the old name was found.
findServiceCodegen :: Bool -> IO (Maybe (ToolPath, Maybe Text))
findServiceCodegen debug = do
  new <- findTool debug serviceCodegenName (codegenFallbackPaths serviceCodegenName)
  case new of
    Just path -> pure (Just (path, Nothing))
    Nothing -> do
      old <- findTool debug oldCodegenName (codegenFallbackPaths oldCodegenName)
      pure $ fmap (\path -> (path, Just (oldNameNote path))) old
  where
    oldNameNote path =
      "found the code generator under its old name, " <> T.pack oldCodegenName <> " ("
        <> T.pack (toolPathToFilePath path) <> "); the name is deprecated: install "
        <> T.pack serviceCodegenName <> " (0.5.1 or later) — the old name goes in NAMING-18"

-- | Fallback paths for the generator under a name (checked if not in PATH):
-- the sibling checkout's build, then the install directories.
codegenFallbackPaths :: String -> IO [FilePath]
codegenFallbackPaths name = do
  home <- getHomeDirectory
  let devPaths =
        [ ".." </> name </> "target/release" </> name
        , ".." </> name </> "target/debug" </> name
        , "../.." </> name </> "target/release" </> name
        , "../.." </> name </> "target/debug" </> name
        ]
      installPaths =
        [ home </> ".plexus/bin" </> name
        , home </> ".cargo/bin" </> name
        ]
  pure $ devPaths ++ installPaths

-- ============================================================================
-- Suggestions
-- ============================================================================

synapseSuggestions :: [Text]
synapseSuggestions =
  [ "Install synapse: cd ../synapse && cabal install exe:synapse"
  , "Or specify path: --synapse /path/to/synapse"
  , "Add to PATH: export PATH=\"$HOME/.local/bin:$PATH\""
  ]

serviceCodegenSuggestions :: [Text]
serviceCodegenSuggestions =
  [ "Install service-codegen: cd ../service-codegen && cargo install --path ."
  , "Or specify path: --service-codegen /path/to/service-codegen"
  , "Add to PATH: export PATH=\"$HOME/.cargo/bin:$PATH\""
  ]