dojang-0.2.0: src/Dojang/Commands/Edit.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
-- | This module provides the @edit@ command which opens source files
-- in the user's editor and applies changes after editing.
module Dojang.Commands.Edit
( defaultEditor
, edit
, getEditor
, runEditor
) where
import Control.Monad (filterM, foldM, forM, forM_, unless, when)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.List (isPrefixOf, nub)
import System.Environment (lookupEnv)
import System.Exit (ExitCode (..), exitWith)
import System.IO (hIsTerminalDevice, stderr, stdin)
import System.Process (spawnProcess, waitForProcess)
import Control.Monad.Logger (logDebugSH)
import Data.List.NonEmpty qualified as NE
import Data.Text (Text, pack)
import FortyTwo.Prompts.Confirm (confirm)
import FortyTwo.Prompts.Select (select)
import System.Directory.OsPath (makeAbsolute)
import System.OsPath (OsPath, makeRelative, normalise, splitDirectories, (</>))
import TextShow (showt)
import Dojang.App (App, ensureContext)
import Dojang.Commands
( Admonition (..)
, codeStyleFor
, die'
, dieWithErrors
, pathStyleFor
, printStderr
, printStderr'
)
import Dojang.Commands.Apply qualified (apply)
import Dojang.Commands.Disambiguation
( disambiguateRoutes
, getAutoSelectMode
)
import Dojang.Commands.Status (printWarnings)
import Dojang.ExitCodes
( ambiguousRouteError
, externalProgramNonZeroExit
, fileNotRoutedError
, sourceCannotBeTargetError
, userCancelledError
)
import Dojang.MonadFileSystem (MonadFileSystem (..))
import Dojang.MonadFileSystem qualified as FS
import Dojang.Types.Context
( CandidateRoute (..)
, Context (..)
, FileCorrespondence (..)
, FileDeltaKind (..)
, FileEntry (..)
, IgnoredFile (..)
, RouteMatch (..)
, findCandidateRoutesFor
, findMatchingRoutes
, getIgnoredFiles
, makeCorrespond
, makeCorrespondBetweenThreeFiles
)
import Dojang.Types.Repository (Repository (..), RouteResult (..))
-- | The default editor for the platform.
defaultEditor :: String
#ifdef mingw32_HOST_OS
defaultEditor = "notepad"
#else
defaultEditor = "vi"
#endif
-- | Get the editor to use, checking --editor option, then VISUAL, then EDITOR.
-- Returns Nothing if no editor is specified (caller should use defaultEditor).
getEditor :: (MonadIO m) => Maybe String -> m (Maybe String)
getEditor (Just editor) = return $ Just editor
getEditor Nothing = liftIO $ do
visual <- lookupEnv "VISUAL"
case visual of
Just v -> return $ Just v
Nothing -> lookupEnv "EDITOR"
-- | Run the editor with the given files.
runEditor
:: (MonadIO m)
=> String
-- ^ The editor program to run.
-> [FilePath]
-- ^ The files to edit.
-> m ExitCode
runEditor editor files = liftIO $ do
handle <- spawnProcess editor files
waitForProcess handle
-- | The edit command: open source files in an editor and apply changes.
edit
:: (MonadFileSystem i, MonadIO i)
=> Maybe String
-- ^ The @--editor@ option.
-> Bool
-- ^ The @--no-apply@ flag.
-> Bool
-- ^ The @--force@ flag.
-> Bool
-- ^ The @--sequential@ flag.
-> Bool
-- ^ The @--all@ flag (skip confirmation).
-> Bool
-- ^ The @--include-unregistered@ flag.
-> Maybe OsPath
-- ^ The @--source@ option for disambiguation.
-> [OsPath]
-- ^ The target file paths to edit (may be empty for all changed files).
-> App i ExitCode
edit editorOpt noApply force sequential allFlag _includeUnregistered _explicitSource [] = do
-- No arguments: edit source files of all changed files
ctx <- ensureContext
pathStyle <- pathStyleFor stderr
codeStyle <- codeStyleFor stderr
(allFiles, ws) <- makeCorrespond ctx
let changedFiles = filter isChanged allFiles
printWarnings ws
-- Get ignored files and warn about them
ignoredFiles <- getIgnoredFiles ctx
-- Filter to only ignored files that exist in destination
existingIgnored <- filterM (exists . (.destinationPath)) ignoredFiles
-- Create correspondences for ignored files if --force is used
ignoredCorrespondences <-
if force && not (null existingIgnored)
then do
forM existingIgnored $ \ignored -> do
let interPath =
ctx.repository.intermediatePath
</> ignored.routeName
</> makeRelative
(normalise ignored.routeName)
(normalise ignored.sourcePath)
makeCorrespondBetweenThreeFiles
interPath
ignored.sourcePath
ignored.destinationPath
else return []
let changedIgnored = filter isChanged ignoredCorrespondences
-- Print warnings for ignored files
unless (null existingIgnored) $ do
if force
then do
printStderr' Note $
"Including "
<> pack (show $ length existingIgnored)
<> " ignored file(s) due to "
<> codeStyle "--force"
<> ":"
forM_ existingIgnored $ \ignored -> do
printStderr $
" "
<> pathStyle ignored.destinationPath
<> " (pattern: "
<> codeStyle (pack $ show ignored.pattern)
<> ")"
else do
printStderr' Warning $
"Skipping "
<> pack (show $ length existingIgnored)
<> " ignored file(s):"
forM_ existingIgnored $ \ignored -> do
printStderr $
" "
<> pathStyle ignored.destinationPath
<> " (pattern: "
<> codeStyle (pack $ show ignored.pattern)
<> ")"
printStderr' Hint $
"Use "
<> codeStyle "--force"
<> " to include ignored files."
let allChangedFiles = changedFiles ++ changedIgnored
if null allChangedFiles
then do
printStderr "No changed files to edit."
return ExitSuccess
else do
-- Display changed files
printStderr $
"Found "
<> pack (show $ length allChangedFiles)
<> " changed file(s):"
forM_ allChangedFiles $ \fc -> do
printStderr $ " " <> pathStyle fc.source.path
-- Confirm unless --all is specified
proceed <-
if allFlag
then return True
else do
isTerminal <- liftIO $ hIsTerminalDevice stdin
if isTerminal
then liftIO $ confirm "Edit all changed source files?"
else return True -- Non-interactive: proceed
if proceed
then do
let sourceFiles = map (.source.path) allChangedFiles
runEditorOnFiles editorOpt noApply force sequential sourceFiles
else do
printStderr "Cancelled."
liftIO $ exitWith userCancelledError
edit editorOpt noApply force sequential _allFlag _includeUnregistered explicitSource paths = do
ctx <- ensureContext
pathStyle <- pathStyleFor stderr
codeStyle <- codeStyleFor stderr
-- Make paths absolute first.
absPaths <- liftIO $ mapM makeAbsolute paths
$(logDebugSH) (absPaths :: [OsPath])
-- Check if any target is inside the source repository (not allowed).
sourcePath' <- liftIO $ makeAbsolute ctx.repository.sourcePath
let sourcePathPrefix = splitDirectories sourcePath'
let overlappedPaths =
[ p
| p <- absPaths
, sourcePathPrefix `isPrefixOf` splitDirectories p
]
$(logDebugSH) overlappedPaths
unless (null overlappedPaths) $
dieWithErrors
sourceCannotBeTargetError
[ "Cannot edit "
<> pathStyle p
<> " because it is a file inside the repository."
| p <- overlappedPaths
]
-- Separate existing and non-existing files.
(existingPaths, nonExistentPaths) <- partitionM exists absPaths
$(logDebugSH) (nonExistentPaths :: [OsPath])
-- Map each existing target path to its source file.
autoSelectMode <- getAutoSelectMode
existingSourceFiles <- forM existingPaths $ \targetPath -> do
(routeMatch, ws) <- findMatchingRoutes ctx targetPath
printWarnings $ nub ws
case routeMatch of
NoMatch -> do
printStderr' Error ("File " <> pathStyle targetPath <> " is not routed.")
printStderr' Hint "Add a route for it in your manifest (dojang.toml)."
liftIO $ exitWith fileNotRoutedError
SingleMatch route -> do
srcPath <- computeSourcePath ctx targetPath route
return srcPath
AmbiguousMatch candidates -> do
maybeRoute <- disambiguateRoutes autoSelectMode explicitSource candidates
case maybeRoute of
Nothing -> do
let routeNames = [c.route.routeName | c <- NE.toList candidates]
routeNameStrs <- mapM decodePath routeNames
printStderr' Error $
"Ambiguous source path for "
<> pathStyle targetPath
<> ". Multiple routes match:"
forM_ routeNameStrs $ \name ->
printStderr' Note $ " - " <> codeStyle (pack name)
printStderr'
Hint
$ "Use "
<> codeStyle "--source"
<> " to specify which source path to use, or set "
<> codeStyle "DOJANG_AUTO_SELECT=first"
<> " to auto-select."
liftIO $ exitWith ambiguousRouteError
Just route -> do
srcPath <- computeSourcePath ctx targetPath route
return srcPath
-- Handle non-existent files: find candidate routes and create source files.
newSourceFiles <- forM nonExistentPaths $ \targetPath -> do
candidates <- findCandidateRoutesFor ctx targetPath
case candidates of
[] -> do
printStderr' Error ("File " <> pathStyle targetPath <> " is not routed.")
printStderr' Hint "Add a route for it in your manifest (dojang.toml)."
liftIO $ exitWith fileNotRoutedError
[route] -> do
srcPath <- computeSourcePath ctx targetPath route
createEmptySourceFile pathStyle srcPath
return srcPath
(firstRoute : restRoutes) -> do
let routes = firstRoute : restRoutes
-- Multiple routes: prompt for selection.
isTerminal <- liftIO $ hIsTerminalDevice stdin
if isTerminal
then do
routeLabels <- forM routes $ \route -> do
routeName' <- decodePath route.routeName
return routeName'
printStderr' Note $
"Multiple routes can create " <> pathStyle targetPath <> ":"
selectedLabel <-
liftIO $ select "Select route to use:" routeLabels
-- Find the route that matches the selected label.
matchingRoutes <-
filterM
( \r -> do
name <- decodePath r.routeName
return (name == selectedLabel)
)
routes
let selectedRoute = case matchingRoutes of
(match : _) -> match
[] -> firstRoute -- Fallback to first if no match.
srcPath <- computeSourcePath ctx targetPath selectedRoute
createEmptySourceFile pathStyle srcPath
return srcPath
else do
-- Non-interactive: use first route.
routeName' <- decodePath firstRoute.routeName
printStderr' Note $
"Auto-selecting route "
<> codeStyle (pack routeName')
<> " for "
<> pathStyle targetPath
srcPath <- computeSourcePath ctx targetPath firstRoute
createEmptySourceFile pathStyle srcPath
return srcPath
let sourceFiles = existingSourceFiles ++ newSourceFiles
runEditorOnFiles editorOpt noApply force sequential sourceFiles
-- | Check if a file correspondence has changes.
isChanged :: FileCorrespondence -> Bool
isChanged fc = fc.sourceDelta /= Unchanged || fc.destinationDelta /= Unchanged
-- | Run the editor on the given source files.
runEditorOnFiles
:: (MonadFileSystem i, MonadIO i)
=> Maybe String
-- ^ The @--editor@ option.
-> Bool
-- ^ The @--no-apply@ flag.
-> Bool
-- ^ The @--force@ flag.
-> Bool
-- ^ The @--sequential@ flag.
-> [OsPath]
-- ^ The source file paths to edit.
-> App i ExitCode
runEditorOnFiles editorOpt noApply force sequential sourceFiles = do
pathStyle <- pathStyleFor stderr
-- Get the editor to use.
maybeEditor <- getEditor editorOpt
let editor = maybe defaultEditor id maybeEditor
-- Convert source paths to FilePath for the editor.
sourceFilePaths <- mapM decodePath sourceFiles
-- Early return if no files.
case sourceFiles of
[] -> return ExitSuccess
(firstFile : _) -> do
-- Run the editor.
printStderr $
"Opening " <> pathStyle firstFile <> " in " <> pack editor <> "..."
if sequential
then do
-- Sequential mode: edit one file at a time.
forM_ sourceFilePaths $ \srcPath -> do
srcOsPath <- encodePath srcPath
printStderr $ "Editing " <> pathStyle srcOsPath <> "..."
exitCode <- runEditor editor [srcPath]
when (exitCode /= ExitSuccess) $ do
die' externalProgramNonZeroExit $
pack editor <> " exited with code " <> showt exitCode <> "."
-- Apply after each file if not disabled.
unless noApply $ do
printStderr "Applying changes..."
_ <- Dojang.Commands.Apply.apply force []
return ()
else do
-- Concurrent mode: open all files at once.
exitCode <- runEditor editor sourceFilePaths
when (exitCode /= ExitSuccess) $ do
die' externalProgramNonZeroExit $
pack editor <> " exited with code " <> showt exitCode <> "."
-- Apply changes if not disabled.
unless noApply $ do
printStderr "Applying changes..."
_ <- Dojang.Commands.Apply.apply force []
return ()
return ExitSuccess
-- | Compute the source path for a target path given a route.
-- This follows the same pattern as Reflect.hs 'makeCorrespondForRoute'.
computeSourcePath
:: (MonadFileSystem m)
=> Context m
-> OsPath
-- ^ The target (destination) path.
-> RouteResult
-- ^ The matching route.
-> m OsPath
computeSourcePath _ctx targetPath route = do
period <- encodePath "."
let normalized = normalise route.destinationPath
let relPath = makeRelative normalized targetPath
if normalized == targetPath || relPath == period
then return $ normalise route.sourcePath
else return $ normalise $ route.sourcePath </> relPath
-- | Partition a list based on a monadic predicate.
partitionM :: (Monad m) => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM p xs = foldM go ([], []) xs
where
go (ts, fs) x = do
b <- p x
return $ if b then (ts ++ [x], fs) else (ts, fs ++ [x])
-- | Create an empty source file for a new file.
createEmptySourceFile
:: (MonadFileSystem m, MonadIO m)
=> (OsPath -> Text)
-- ^ Path style function for display.
-> OsPath
-- ^ The source file path to create.
-> m ()
createEmptySourceFile pathStyle srcPath = do
srcExists <- exists srcPath
unless srcExists $ do
printStderr $ "Creating new source file: " <> pathStyle srcPath
FS.writeFile srcPath ""