packages feed

synapse-cc-0.2.0: src/SynapseCC/Config.hs

{-# LANGUAGE OverloadedStrings #-}

-- | synapse.config.json loader and validator
module SynapseCC.Config
  ( loadSynapseConfig
  , validateSynapseConfig
  , initSynapseConfig
  , synapseConfigPath

    -- * Shared config-to-runtime conversions
  , parseWsUrl
  , buildConfigFromTarget
  ) where

import Data.Aeson (eitherDecodeFileStrict)
import qualified Data.Aeson.Encode.Pretty as Pretty
import qualified Data.ByteString.Lazy as BL
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import System.Directory (doesFileExist)

import SynapseCC.Detect (Detector, ProjectHint(..), runDetectors)
import SynapseCC.Types

-- | Standard config file name (looked up from CWD)
synapseConfigPath :: FilePath
synapseConfigPath = "synapse.config.json"

-- | Load synapse.config.json from the current directory.
-- Returns Left if the file doesn't exist or fails to parse.
loadSynapseConfig :: IO (Either Text SynapseConfig)
loadSynapseConfig = loadSynapseConfigFrom synapseConfigPath

-- | Load from an explicit path (for hot-reload)
loadSynapseConfigFrom :: FilePath -> IO (Either Text SynapseConfig)
loadSynapseConfigFrom path = do
  exists <- doesFileExist path
  if not exists
    then pure $ Left $ "synapse.config.json not found at " <> T.pack path
                    <> " — run 'synapse-cc init' to create one"
    else do
      result <- eitherDecodeFileStrict path
      case result of
        Left err  -> pure $ Left $ T.pack err
        Right cfg -> case validateSynapseConfig cfg of
          Left verr -> pure $ Left verr
          Right ()  -> pure $ Right cfg

-- | Validate a loaded SynapseConfig, returning the first error found.
validateSynapseConfig :: SynapseConfig -> Either Text ()
validateSynapseConfig cfg = do
  requireNonEmpty "language" (scLanguage cfg)
  -- backend and url are required only when at least one target needs a backend.
  -- A target with generate: ["transport"] is backend-free.
  let needsBackend = any ((/= ["transport"]) . tcGenerate) (Map.elems (scTargets cfg))
  if needsBackend
    then case scBackend cfg of
           Nothing -> Left "\"backend\" is required when targets need a backend connection"
           Just b  -> requireNonEmpty "backend" b
    else Right ()
  if Map.null (scTargets cfg)
    then Left "At least one entry under \"targets\" is required"
    else mapM_ (validateTargetConfig (scTargets cfg)) (Map.toList (scTargets cfg))
  where
    requireNonEmpty field val =
      if T.null (T.strip val)
        then Left $ "\"" <> field <> "\" must not be empty"
        else Right ()

validateTargetConfig :: Map Text TargetConfig -> (Text, TargetConfig) -> Either Text ()
validateTargetConfig _all (name, tc) = do
  if null (tcGenerate tc)
    then Left $ "target \"" <> name <> "\": \"generate\" list must not be empty"
    else Right ()
  if null (tcOutputDir tc)
    then Left $ "target \"" <> name <> "\": \"outputDir\" must not be empty"
    else Right ()

-- ============================================================================
-- Config-to-Runtime Conversions
-- ============================================================================

-- | Parse host and port from a ws:// or wss:// URL.
-- Defaults port to "4444" when absent.
parseWsUrl :: Text -> (Text, Text)
parseWsUrl url =
  let stripped = case T.stripPrefix "wss://" url of
        Just s  -> s
        Nothing -> case T.stripPrefix "ws://" url of
          Just s  -> s
          Nothing -> url
      (host, rest) = T.breakOn ":" stripped
      port         = T.takeWhile (/= '/') (T.drop 1 rest)
  in (host, if T.null port then "4444" else port)

-- | Build a runtime Config from a set of CLI options, a SynapseConfig, and one target.
-- The target's outputDir and transport override the options; all other options
-- (--debug, --force, --no-install, etc.) are inherited as-is.
buildConfigFromTarget :: Options -> SynapseConfig -> TargetConfig -> Config
buildConfigFromTarget opts sc tc =
  let url            = fromMaybe "ws://127.0.0.1:4444" (scUrl sc)
      (host, port)   = parseWsUrl url
      backendName    = fromMaybe "" (scBackend sc)
  in Config
       { cfgTarget  = parseLanguage (scLanguage sc)
       , cfgBackend = Backend backendName
       , cfgHost    = host
       , cfgPort    = port
       , cfgOptions = opts
           { optOutput    = tcOutputDir tc
           , optTransport = tcTransport tc
           }
       }

-- | Scaffold a synapse.config.json, using 'detectors' to infer the right
-- transport and other settings for the current project.
--
-- Returns @Left@ if the file already exists.
-- Returns @Right hint@ on success — the caller can inspect 'phReason' to
-- print a message explaining what was detected.
--
-- Pass 'SynapseCC.Detect.defaultDetectors' for the standard set, or prepend
-- additional detectors for project-specific overrides.
initSynapseConfig :: FilePath -> [Detector] -> IO (Either Text ProjectHint)
initSynapseConfig path detectors = do
  exists <- doesFileExist path
  if exists
    then pure $ Left $ T.pack path <> " already exists"
    else do
      hint <- runDetectors detectors
      let config = applyHint hint defaultSynapseConfig
      BL.writeFile path (Pretty.encodePretty' prettyConfig config)
      pure $ Right hint

-- | Apply detected hints to the default config.
applyHint :: ProjectHint -> SynapseConfig -> SynapseConfig
applyHint hint cfg =
  case phTransport hint of
    Nothing -> cfg
    Just t  -> cfg
      { scTargets = Map.map (\tc -> tc { tcTransport = t }) (scTargets cfg)
      }

-- | aeson-pretty config: 2-space indent, semantic field ordering.
prettyConfig :: Pretty.Config
prettyConfig = Pretty.defConfig
  { Pretty.confCompare = Pretty.keyOrder
      [ "schema", "language", "backend", "url", "packageManager"
      , "watch", "pollInterval", "hotReload"
      , "targets", "generate", "transport", "outputDir", "smokePath"
      ]
  }