{-# OPTIONS_GHC -Wno-orphans #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Client.Tar
-- Copyright   :  (c) 2007 Bjorn Bringert,
--                    2008 Andrea Vezzosi,
--                    2008-2009 Duncan Coutts
-- License     :  BSD3
--
-- Maintainer  :  duncan@community.haskell.org
-- Portability :  portable
--
-- Reading, writing and manipulating \"@.tar@\" archive files.
module Distribution.Client.Tar
  ( -- * @tar.gz@ operations
    TarComp.createTarGzFile
  , TarComp.extractTarGzFile

    -- * Other local utils
  , buildTreeRefTypeCode
  , buildTreeSnapshotTypeCode
  , isBuildTreeRefTypeCode
  , filterEntries
  , filterEntriesM
  , entriesToList
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Entry as Tar
import qualified Distribution.Client.Compat.Tar as TarComp

-- for foldEntries...
import Control.Exception (throw)

--

-- * High level operations

-- | Type code for the local build tree reference entry type. We don't use the
-- symbolic link entry type because it allows only 100 ASCII characters for the
-- path.
buildTreeRefTypeCode :: Tar.TypeCode
buildTreeRefTypeCode :: TypeCode
buildTreeRefTypeCode = TypeCode
'C'

-- | Type code for the local build tree snapshot entry type.
buildTreeSnapshotTypeCode :: Tar.TypeCode
buildTreeSnapshotTypeCode :: TypeCode
buildTreeSnapshotTypeCode = TypeCode
'S'

-- | Is this a type code for a build tree reference?
isBuildTreeRefTypeCode :: Tar.TypeCode -> Bool
isBuildTreeRefTypeCode :: TypeCode -> Bool
isBuildTreeRefTypeCode TypeCode
typeCode
  | ( TypeCode
typeCode TypeCode -> TypeCode -> Bool
forall a. Eq a => a -> a -> Bool
== TypeCode
buildTreeRefTypeCode
        Bool -> Bool -> Bool
|| TypeCode
typeCode TypeCode -> TypeCode -> Bool
forall a. Eq a => a -> a -> Bool
== TypeCode
buildTreeSnapshotTypeCode
    ) =
      Bool
True
  | Bool
otherwise = Bool
False

filterEntries :: (Tar.Entry -> Bool) -> Tar.Entries e -> Tar.Entries e
filterEntries :: forall e. (Entry -> Bool) -> Entries e -> Entries e
filterEntries Entry -> Bool
p =
  (Entry -> Entries e -> Entries e)
-> Entries e -> (e -> Entries e) -> Entries e -> Entries e
forall content tarPath linkTarget a e.
(GenEntry content tarPath linkTarget -> a -> a)
-> a -> (e -> a) -> GenEntries content tarPath linkTarget e -> a
Tar.foldEntries
    (\Entry
e Entries e
es -> if Entry -> Bool
p Entry
e then Entry -> Entries e -> Entries e
forall content tarPath linkTarget e.
GenEntry content tarPath linkTarget
-> GenEntries content tarPath linkTarget e
-> GenEntries content tarPath linkTarget e
Tar.Next Entry
e Entries e
es else Entries e
es)
    Entries e
forall content tarPath linkTarget e.
GenEntries content tarPath linkTarget e
Tar.Done
    e -> Entries e
forall content tarPath linkTarget e.
e -> GenEntries content tarPath linkTarget e
Tar.Fail

filterEntriesM
  :: Monad m
  => (Tar.Entry -> m Bool)
  -> Tar.Entries e
  -> m (Tar.Entries e)
filterEntriesM :: forall (m :: * -> *) e.
Monad m =>
(Entry -> m Bool) -> Entries e -> m (Entries e)
filterEntriesM Entry -> m Bool
p =
  (Entry -> m (Entries e) -> m (Entries e))
-> m (Entries e)
-> (e -> m (Entries e))
-> Entries e
-> m (Entries e)
forall content tarPath linkTarget a e.
(GenEntry content tarPath linkTarget -> a -> a)
-> a -> (e -> a) -> GenEntries content tarPath linkTarget e -> a
Tar.foldEntries
    ( \Entry
entry m (Entries e)
rest -> do
        keep <- Entry -> m Bool
p Entry
entry
        xs <- rest
        if keep
          then return (Tar.Next entry xs)
          else return xs
    )
    (Entries e -> m (Entries e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Entries e
forall content tarPath linkTarget e.
GenEntries content tarPath linkTarget e
Tar.Done)
    (Entries e -> m (Entries e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entries e -> m (Entries e))
-> (e -> Entries e) -> e -> m (Entries e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Entries e
forall content tarPath linkTarget e.
e -> GenEntries content tarPath linkTarget e
Tar.Fail)

entriesToList :: Exception e => Tar.Entries e -> [Tar.Entry]
entriesToList :: forall e. Exception e => Entries e -> [Entry]
entriesToList = (Entry -> [Entry] -> [Entry])
-> [Entry]
-> (e -> [Entry])
-> GenEntries ByteString TarPath LinkTarget e
-> [Entry]
forall content tarPath linkTarget a e.
(GenEntry content tarPath linkTarget -> a -> a)
-> a -> (e -> a) -> GenEntries content tarPath linkTarget e -> a
Tar.foldEntries (:) [] e -> [Entry]
forall a e. (HasCallStack, Exception e) => e -> a
throw