packages feed

seihou-cli-0.4.0.0: src-exe/Seihou/CLI/NewModule.hs

module Seihou.CLI.NewModule
  ( handleNewModule,
  )
where

import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Seihou.CLI.Commands (NewModuleOpts (..))
import Seihou.CLI.SchemaVersion (schemaHash, schemaUrl)
import Seihou.CLI.Shared (logIO)
import Seihou.Core.Scaffold (moduleDhall, readmeTemplate)
import Seihou.Core.Types (LogLevel (..))
import Seihou.Effect.Logger (logError)
import Seihou.Prelude
import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
import System.Exit (exitFailure)

handleNewModule :: NewModuleOpts -> IO ()
handleNewModule nopts = do
  let name = nopts.newModuleName

  -- Validate module name format
  if not (isValidModuleName name)
    then do
      logIO LogNormal $ do
        logError $ "invalid module name '" <> name <> "'."
        logError "Module names must match [a-z][a-z0-9-]*."
      exitFailure
    else pure ()

  -- Determine output directory
  let outputDir = case nopts.newModulePath of
        Just p -> p
        Nothing -> T.unpack name

  -- Check that the target directory does not already exist
  exists <- doesDirectoryExist outputDir
  if exists
    then do
      logIO LogNormal (logError $ "directory '" <> T.pack outputDir <> "' already exists.")
      exitFailure
    else pure ()

  -- Create directory structure
  createDirectoryIfMissing True (outputDir </> "files")

  -- Write module.dhall
  let dhallContent = moduleDhall name schemaUrl schemaHash
  writeFile (outputDir </> "module.dhall") (T.unpack dhallContent)
  TIO.putStrLn $ "Created " <> T.pack (outputDir </> "module.dhall")

  -- Write files/README.md.tpl
  let templateContent = readmeTemplate
  writeFile (outputDir </> "files" </> "README.md.tpl") (T.unpack templateContent)
  TIO.putStrLn $ "Created " <> T.pack (outputDir </> "files" </> "README.md.tpl")

  TIO.putStrLn $ "Module '" <> name <> "' created at " <> T.pack outputDir <> "/"

-- | Check if a module name matches [a-z][a-z0-9-]*
isValidModuleName :: Text -> Bool
isValidModuleName t = case T.uncons t of
  Nothing -> False
  Just (c, rest) ->
    (c >= 'a' && c <= 'z')
      && T.all (\ch -> (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9') || ch == '-') rest