synapse-cc-0.2.0: src/SynapseCC/Language.hs
-- | Language-specific integrations (dependency install, build, etc.)
module SynapseCC.Language
( installDependencies
, addDependencies
, buildProject
, runTests
) where
import Control.Monad (when)
import Data.Aeson (eitherDecodeFileStrict, Value(..))
import qualified Data.Aeson.Key as AKey
import qualified Data.Aeson.KeyMap as KM
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import System.Directory (doesFileExist, findExecutable)
import System.Exit (ExitCode(..))
import System.FilePath ((</>))
import SynapseCC.Types
import SynapseCC.Process
-- ============================================================================
-- Language Integration (Phase 2)
-- ============================================================================
-- | Supported package managers for TypeScript
data PackageManager
= Npm
| Pnpm
| Yarn
| Bun
deriving (Show, Eq)
-- | Get install command name for package manager
packageManagerCommand :: PackageManager -> String
packageManagerCommand = \case
Npm -> "npm"
Pnpm -> "pnpm"
Yarn -> "yarn"
Bun -> "bun"
-- | Get (command, args-prefix) for running an exec via the package manager
-- e.g. bun x tsc, pnpm exec tsc, npx tsc
packageManagerExec :: PackageManager -> (String, [String])
packageManagerExec = \case
Bun -> ("bun", ["x"])
Pnpm -> ("pnpm", ["exec"])
Yarn -> ("yarn", [])
Npm -> ("npx", [])
-- | Get (command, args) for running tests via the package manager
packageManagerTestCmd :: PackageManager -> (String, [String])
packageManagerTestCmd = \case
Bun -> ("bun", ["test"])
Pnpm -> ("pnpm", ["test"])
Yarn -> ("yarn", ["test"])
Npm -> ("npm", ["test"])
-- | Detect which package manager to use for TypeScript project
detectPackageManager :: GeneratedPath -> Bool -> IO PackageManager
detectPackageManager (GeneratedPath path) debug = do
when debug $ putStrLn "[*] Detecting package manager..."
-- Priority 1: Check for lockfiles (most reliable signal)
hasBunLock <- (||) <$> doesFileExist (path </> "bun.lock")
<*> doesFileExist (path </> "bun.lockb")
if hasBunLock
then do
when debug $ putStrLn " [+] Found bun.lock, using bun"
pure Bun
else do
hasPnpmLock <- doesFileExist (path </> "pnpm-lock.yaml")
if hasPnpmLock
then do
when debug $ putStrLn " [+] Found pnpm-lock.yaml, using pnpm"
pure Pnpm
else do
hasYarnLock <- doesFileExist (path </> "yarn.lock")
if hasYarnLock
then do
when debug $ putStrLn " [+] Found yarn.lock, using yarn"
pure Yarn
else do
hasNpmLock <- doesFileExist (path </> "package-lock.json")
if hasNpmLock
then do
when debug $ putStrLn " [+] Found package-lock.json, using npm"
pure Npm
else do
-- Priority 2: Check available commands (prefer bun > pnpm > yarn > npm)
hasBun <- isJust <$> findExecutable "bun"
if hasBun
then do
when debug $ putStrLn " [+] bun available, using bun"
pure Bun
else do
hasPnpm <- isJust <$> findExecutable "pnpm"
if hasPnpm
then do
when debug $ putStrLn " [+] pnpm available, using pnpm"
pure Pnpm
else do
hasYarn <- isJust <$> findExecutable "yarn"
if hasYarn
then do
when debug $ putStrLn " [+] yarn available, using yarn"
pure Yarn
else do
when debug $ putStrLn " [+] Defaulting to npm"
pure Npm
-- | Provide helpful suggestions based on error patterns
checkInstallError :: Text -> [Text]
checkInstallError stderr
| "EACCES" `T.isInfixOf` stderr =
["Permission denied - try: sudo chown -R $USER ~/.npm"]
| "ENOTFOUND" `T.isInfixOf` stderr =
["Network error - check your internet connection"]
| "ENETUNREACH" `T.isInfixOf` stderr =
["Network unreachable - check firewall/proxy settings"]
| otherwise = []
-- ============================================================================
-- Dependency Installation
-- ============================================================================
-- | Install dependencies for generated code
installDependencies :: Target -> GeneratedPath -> Bool -> IO (Either SynapseCCError ())
installDependencies TypeScript genPath debug = do
when debug $ putStrLn $ "[*] Installing dependencies in " ++ unGeneratedPath genPath
-- Detect package manager
pm <- detectPackageManager genPath debug
let pmCmd = packageManagerCommand pm
-- Verify package manager is actually available
mbPmPath <- findExecutable pmCmd
case mbPmPath of
Nothing -> pure $ Left $ ToolNotFound (T.pack pmCmd)
[ "Install Node.js from https://nodejs.org"
, "Or install " <> T.pack pmCmd <> " separately: npm install -g " <> T.pack pmCmd
]
Just _ -> do
-- Run install command
result <- runProcess pmCmd ["install"] (Just $ unGeneratedPath genPath) debug
case prExitCode result of
ExitSuccess -> do
when debug $ putStrLn " [+] Dependencies installed"
pure $ Right ()
ExitFailure code -> do
let suggestions = checkInstallError (prStderr result)
pure $ Left $ LanguageToolError
(T.pack $ pmCmd ++ " install")
(if null suggestions
then prStderr result
else prStderr result <> "\n\nSuggestions:\n" <> T.unlines suggestions)
code
installDependencies Python _ debug = do
when debug $ putStrLn "[*] Python dependency installation not yet implemented (Phase 2 TODO)"
pure $ Right ()
installDependencies Rust _ debug = do
when debug $ putStrLn "[*] Rust dependency installation not yet implemented (Phase 2 TODO)"
pure $ Right ()
-- | Add specific packages to the project using the detected package manager.
-- Calls @pm add \<pkgs\>@ for runtime deps and @pm add -D \<pkgs\>@ for dev deps.
-- Skips packages already present in package.json (no-op on subsequent builds).
-- Returns True if packages were actually added, False if all were already present.
addDependencies
:: GeneratedPath
-> Map Text Text -- ^ Runtime dependencies (name -> version)
-> Map Text Text -- ^ Dev dependencies (name -> version)
-> Bool -- ^ Debug
-> IO (Either SynapseCCError Bool)
addDependencies _ deps devDeps _ | Map.null deps && Map.null devDeps = pure (Right False)
addDependencies genPath deps devDeps debug = do
existing <- readExistingDeps (unGeneratedPath genPath)
let newDeps = Map.filterWithKey (\k _ -> k `Map.notMember` existing) deps
newDevDeps = Map.filterWithKey (\k _ -> k `Map.notMember` existing) devDeps
if Map.null newDeps && Map.null newDevDeps
then pure (Right False)
else do
pm <- detectPackageManager genPath debug
let pmCmd = packageManagerCommand pm
dir = Just (unGeneratedPath genPath)
-- Add runtime deps
rtResult <- if Map.null newDeps then pure (Right ()) else do
let pkgs = Map.keys newDeps
when debug $ putStrLn $ " [+] " <> pmCmd <> " add " <> unwords (map T.unpack pkgs)
r <- runProcess pmCmd ("add" : map T.unpack pkgs) dir debug
pure $ case prExitCode r of
ExitSuccess -> Right ()
ExitFailure c -> Left $ LanguageToolError (T.pack pmCmd <> " add") (prStderr r) c
-- Add dev deps
devResult <- if Map.null newDevDeps then pure (Right ()) else do
let pkgs = Map.keys newDevDeps
when debug $ putStrLn $ " [+] " <> pmCmd <> " add -D " <> unwords (map T.unpack pkgs)
r <- runProcess pmCmd (["add", "-D"] <> map T.unpack pkgs) dir debug
pure $ case prExitCode r of
ExitSuccess -> Right ()
ExitFailure c -> Left $ LanguageToolError (T.pack pmCmd <> " add -D") (prStderr r) c
pure $ fmap (const True) (rtResult >> devResult)
-- | Read all declared dependencies (runtime + dev) from an existing package.json.
-- Returns an empty map if the file doesn't exist or can't be parsed.
readExistingDeps :: FilePath -> IO (Map Text Text)
readExistingDeps dir = do
let pkgPath = dir </> "package.json"
exists <- doesFileExist pkgPath
if not exists then pure Map.empty else do
result <- eitherDecodeFileStrict pkgPath :: IO (Either String Value)
case result of
Left _ -> pure Map.empty
Right (Object o) ->
let extract key = case KM.lookup (AKey.fromText key) o of
Just (Object deps) -> Map.fromList
[ (AKey.toText k, v')
| (k, String v') <- KM.toList deps ]
_ -> Map.empty
in pure $ Map.union (extract "dependencies") (extract "devDependencies")
Right _ -> pure Map.empty
-- ============================================================================
-- Building/Type-checking
-- ============================================================================
-- | Build/compile generated code
buildProject :: Target -> GeneratedPath -> Bool -> IO (Either SynapseCCError CompiledPath)
buildProject TypeScript genPath debug = do
when debug $ putStrLn $ "[*] Type-checking TypeScript in " ++ unGeneratedPath genPath
pm <- detectPackageManager genPath debug
let (cmd, prefix) = packageManagerExec pm
args = prefix ++ ["tsc", "--noEmit"]
result <- runProcess cmd args (Just $ unGeneratedPath genPath) debug
case prExitCode result of
ExitSuccess -> do
when debug $ putStrLn " [+] TypeScript type-check passed"
pure $ Right $ CompiledPath $ unGeneratedPath genPath
ExitFailure code -> do
let combined = T.unlines $ filter (not . T.null . T.strip) [prStdout result, prStderr result]
pure $ Left $ LanguageToolError "tsc" combined code
buildProject Python genPath debug = do
when debug $ putStrLn "[*] Python build not yet implemented (Phase 2 TODO)"
pure $ Right $ CompiledPath $ unGeneratedPath genPath
buildProject Rust genPath debug = do
when debug $ putStrLn "[*] Rust build not yet implemented (Phase 2 TODO)"
pure $ Right $ CompiledPath $ unGeneratedPath genPath
-- ============================================================================
-- Testing
-- ============================================================================
-- | Run smoke tests for generated code
runTests :: Target -> GeneratedPath -> Bool -> IO (Either SynapseCCError ())
runTests target genPath debug = case target of
TypeScript -> runTypeScriptTests genPath debug
Python -> pure $ Right () -- TODO: Implement Python tests
Rust -> pure $ Right () -- TODO: Implement Rust tests
-- | Run TypeScript smoke tests
runTypeScriptTests :: GeneratedPath -> Bool -> IO (Either SynapseCCError ())
runTypeScriptTests genPath debug = do
when debug $ putStrLn $ "[*] Running smoke tests in " ++ unGeneratedPath genPath
pm <- detectPackageManager genPath debug
let (cmd, args) = packageManagerTestCmd pm
toolLabel = T.pack cmd <> " test"
result <- runProcess cmd args (Just $ unGeneratedPath genPath) debug
case prExitCode result of
ExitSuccess -> do
when debug $ putStrLn " [+] Tests passed"
pure $ Right ()
ExitFailure code -> do
let combined = T.unlines $ filter (not . T.null . T.strip) [prStdout result, prStderr result]
pure $ Left $ LanguageToolError toolLabel combined code