Extract.hs

module Command.Extract (
    ExtractCommand,
) where

import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class

import Data.Text qualified as T

import System.Console.GetOpt
import System.Directory
import System.FilePath

import Command
import Eval
import Job
import Job.Types


data ExtractCommand = ExtractCommand ExtractOptions ExtractArguments

data ExtractArguments = ExtractArguments
    { extractArtifacts :: [ ( JobRef, ArtifactName ) ]
    , extractDestination :: FilePath
    }

instance CommandArgumentsType ExtractArguments where
    argsFromStrings = \case
        args@(_:_:_) -> do
            extractArtifacts <- mapM toArtifactRef (init args)
            extractDestination <- return (last args)
            return ExtractArguments {..}
          where
            toArtifactRef tref = case T.breakOnEnd "." (T.pack tref) of
                (jobref', aref) | Just ( jobref, '.' ) <- T.unsnoc jobref'
                    -> return ( parseJobRef jobref, ArtifactName aref )
                _   -> throwError $ "too few parts in artifact ref ‘" <> tref <> "’"
        _ -> throwError "too few arguments"

data ExtractOptions = ExtractOptions
    { extractForce :: Bool
    }

instance Command ExtractCommand where
    commandName _ = "extract"
    commandDescription _ = "Extract artifacts generated by jobs"

    type CommandArguments ExtractCommand = ExtractArguments

    commandUsage _ = T.pack $ unlines $
        [ "Usage: minici jobid [<option>...] <job ref>.<artifact>... <destination>"
        ]

    type CommandOptions ExtractCommand = ExtractOptions
    defaultCommandOptions _ = ExtractOptions
        { extractForce = False
        }

    commandOptions _ =
        [ Option [ 'f' ] [ "force" ]
            (NoArg $ \opts -> opts { extractForce = True })
            "owerwrite existing files"
        ]

    commandInit _ = ExtractCommand
    commandExec = cmdExtract


cmdExtract :: ExtractCommand -> CommandExec ()
cmdExtract (ExtractCommand ExtractOptions {..} ExtractArguments {..}) = do
    einput <- getEvalInput
    storageDir <- getStorageDir

    isdir <- liftIO (doesDirectoryExist extractDestination) >>= \case
        True -> return True
        False -> case extractArtifacts of
            _:_:_ -> tfail $ "destination ‘" <> T.pack extractDestination <> "’ is not a directory"
            _     -> return False

    forM_ extractArtifacts $ \( ref, aname ) -> do
        jid <- either (tfail . textEvalError) (return . jobId) =<<
            liftIO (runEval (evalJobReference ref) einput)

        tpath <- if
            | isdir -> do
                wpath <- either tfail return =<< runExceptT (getArtifactWorkPath storageDir jid aname)
                return $ extractDestination </> takeFileName wpath
            | otherwise -> return extractDestination

        liftIO (doesPathExist tpath) >>= \case
            True
                | extractForce -> liftIO (doesDirectoryExist tpath) >>= \case
                    True -> liftIO $ removeDirectoryRecursive tpath
                    False -> liftIO $ removeFile tpath
                | otherwise -> tfail $ "destination ‘" <> T.pack tpath <> "’ already exists"
            False -> return ()

        either tfail return =<< runExceptT (copyArtifact storageDir jid aname tpath)