Tar.hs

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

module HaskellWorks.CabalCache.IO.Tar
  ( TarGroup(..)
  , createTar
  , extractTar
  ) where

import Control.DeepSeq                  (NFData)
import Control.Lens
import Control.Monad.Except
import Control.Monad.IO.Class           (MonadIO, liftIO)
import Data.Generics.Product.Any
import GHC.Generics
import HaskellWorks.CabalCache.AppError
import HaskellWorks.CabalCache.Show

import qualified System.Exit    as IO
import qualified System.Process as IO

data TarGroup = TarGroup
  { basePath   :: FilePath
  , entryPaths :: [FilePath]
  } deriving (Show, Eq, Generic, NFData)

createTar :: MonadIO m => FilePath -> [TarGroup] -> ExceptT AppError m ()
createTar tarFile groups = do
  let args = ["-zcf", tarFile] <> foldMap tarGroupToArgs groups
  process <- liftIO $ IO.spawnProcess "tar" args
  exitCode <- liftIO $ IO.waitForProcess process
  case exitCode of
    IO.ExitSuccess   -> return ()
    IO.ExitFailure n -> throwError $ GenericAppError $ "Failed to create tar. Exit code: " <> tshow n

extractTar :: MonadIO m => FilePath -> FilePath -> ExceptT AppError m ()
extractTar tarFile targetPath = do
  process <- liftIO $ IO.spawnProcess "tar" ["-C", targetPath, "-zxf", tarFile]
  exitCode <- liftIO $ IO.waitForProcess process
  case exitCode of
    IO.ExitSuccess   -> return ()
    IO.ExitFailure n -> throwError $ GenericAppError $ "Failed to extract tar.  Exit code: " <> tshow n

tarGroupToArgs :: TarGroup -> [String]
tarGroupToArgs tarGroup = ["-C", tarGroup ^. the @"basePath"] <> tarGroup ^. the @"entryPaths"