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, ArtifactName aname ) -> do
        jid@(JobId ids) <- either (tfail . textEvalError) (return . jobId . fst) =<<
            liftIO (runEval (evalJobReference ref) einput)

        let jdir = joinPath $ (storageDir :) $ ("jobs" :) $ map (T.unpack . textJobIdPart) ids
            adir = jdir </> "artifacts" </> T.unpack aname

        liftIO (doesDirectoryExist jdir) >>= \case
            True -> return ()
            False -> tfail $ "job ‘" <> textJobId jid <> "’ not yet executed"

        liftIO (doesDirectoryExist adir) >>= \case
            True -> return ()
            False -> tfail $ "artifact ‘" <> aname <> "’ of job ‘" <> textJobId jid <> "’ not found"

        afile <- liftIO (listDirectory adir) >>= \case
            [ file ] -> return file
            []       -> tfail $ "artifact ‘" <> aname <> "’ of job ‘" <> textJobId jid <> "’ not found"
            _:_:_    -> tfail $ "unexpected files in ‘" <> T.pack adir <> "’"

        let tpath | isdir = extractDestination </> afile
                  | otherwise = extractDestination
        when (not extractForce) $ do
            liftIO (doesPathExist tpath) >>= \case
                True -> tfail $ "destination ‘" <> T.pack tpath <> "’ already exists"
                False -> return ()
        liftIO $ copyRecursiveForce (adir </> afile) tpath