{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK hide #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Codec.Archive.Tar.Types
-- Copyright   :  (c) 2007 Bjorn Bringert,
--                    2008 Andrea Vezzosi,
--                    2008-2009 Duncan Coutts
--                    2011 Max Bolingbroke
-- License     :  BSD3
--
-- Maintainer  :  duncan@community.haskell.org
-- Portability :  portable
--
-- Types to represent the content of @.tar@ archives.
--
-----------------------------------------------------------------------------
module Codec.Archive.Tar.Types (

  GenEntry(..),
  Entry,
  entryPath,
  GenEntryContent(..),
  EntryContent,
  FileSize,
  Permissions,
  Ownership(..),
  EpochTime,
  TypeCode,
  DevMajor,
  DevMinor,
  Format(..),

  simpleEntry,
  longLinkEntry,
  longSymLinkEntry,
  fileEntry,
  symlinkEntry,
  directoryEntry,

  ordinaryFilePermissions,
  symbolicLinkPermission,
  executableFilePermissions,
  directoryPermissions,

  TarPath(..),
  toTarPath,
  toTarPath',
  ToTarPathResult(..),
  fromTarPath,
  fromTarPathToPosixPath,
  fromTarPathToWindowsPath,
  fromFilePathToNative,

  LinkTarget(..),
  toLinkTarget,
  fromLinkTarget,
  fromLinkTargetToPosixPath,
  fromLinkTargetToWindowsPath,
  fromFilePathToWindowsPath,

  GenEntries(..),
  Entries,
  mapEntries,
  mapEntriesNoFail,
  foldEntries,
  foldlEntries,
  unfoldEntries,
  unfoldEntriesM,
  ) where

import Data.Int      (Int64)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid   (Monoid(..))
import Data.Semigroup as Sem
import Data.Typeable
import qualified Data.ByteString       as BS
import qualified Data.ByteString.Char8 as BS.Char8
import qualified Data.ByteString.Lazy  as LBS
import Control.DeepSeq
import Control.Exception (Exception, displayException)

import qualified System.FilePath as FilePath.Native
         ( joinPath, splitDirectories, addTrailingPathSeparator, hasTrailingPathSeparator, pathSeparator, isAbsolute, hasTrailingPathSeparator )
import qualified System.FilePath.Posix as FilePath.Posix
         ( joinPath, splitPath, splitDirectories, hasTrailingPathSeparator
         , addTrailingPathSeparator, pathSeparator )
import qualified System.FilePath.Windows as FilePath.Windows
         ( joinPath, addTrailingPathSeparator, pathSeparator )
import System.Posix.Types
         ( FileMode )
import "os-string" System.OsString.Posix (PosixString, PosixChar)
import qualified "os-string" System.OsString.Posix as PS

import Codec.Archive.Tar.PackAscii

-- | File size in bytes.
type FileSize  = Int64

-- | The number of seconds since the UNIX epoch.
type EpochTime = Int64

-- | Major device number.
type DevMajor  = Int

-- | Minor device number.
type DevMinor  = Int

-- | User-defined tar format expansion.
type TypeCode  = Char

-- | Permissions information for 'GenEntry'.
type Permissions = FileMode

-- | Polymorphic tar archive entry. High-level interfaces
-- commonly work with 'GenEntry' 'FilePath' 'FilePath',
-- while low-level ones use 'GenEntry' t'TarPath' t'LinkTarget'.
--
-- @since 0.6.0.0
data GenEntry tarPath linkTarget = Entry {

    -- | The path of the file or directory within the archive.
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
entryTarPath :: !tarPath,

    -- | The real content of the entry. For 'NormalFile' this includes the
    -- file data. An entry usually contains a 'NormalFile' or a 'Directory'.
    forall tarPath linkTarget.
GenEntry tarPath linkTarget -> GenEntryContent linkTarget
entryContent :: !(GenEntryContent linkTarget),

    -- | File permissions (Unix style file mode).
    forall tarPath linkTarget.
GenEntry tarPath linkTarget -> Permissions
entryPermissions :: {-# UNPACK #-} !Permissions,

    -- | The user and group to which this file belongs.
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> Ownership
entryOwnership :: {-# UNPACK #-} !Ownership,

    -- | The time the file was last modified.
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> EpochTime
entryTime :: {-# UNPACK #-} !EpochTime,

    -- | The tar format the archive is using.
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> Format
entryFormat :: !Format
  }
  deriving (GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget -> Bool
(GenEntry tarPath linkTarget
 -> GenEntry tarPath linkTarget -> Bool)
-> (GenEntry tarPath linkTarget
    -> GenEntry tarPath linkTarget -> Bool)
-> Eq (GenEntry tarPath linkTarget)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall tarPath linkTarget.
(Eq tarPath, Eq linkTarget) =>
GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget -> Bool
$c== :: forall tarPath linkTarget.
(Eq tarPath, Eq linkTarget) =>
GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget -> Bool
== :: GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget -> Bool
$c/= :: forall tarPath linkTarget.
(Eq tarPath, Eq linkTarget) =>
GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget -> Bool
/= :: GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget -> Bool
Eq, Int -> GenEntry tarPath linkTarget -> ShowS
[GenEntry tarPath linkTarget] -> ShowS
GenEntry tarPath linkTarget -> String
(Int -> GenEntry tarPath linkTarget -> ShowS)
-> (GenEntry tarPath linkTarget -> String)
-> ([GenEntry tarPath linkTarget] -> ShowS)
-> Show (GenEntry tarPath linkTarget)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall tarPath linkTarget.
(Show tarPath, Show linkTarget) =>
Int -> GenEntry tarPath linkTarget -> ShowS
forall tarPath linkTarget.
(Show tarPath, Show linkTarget) =>
[GenEntry tarPath linkTarget] -> ShowS
forall tarPath linkTarget.
(Show tarPath, Show linkTarget) =>
GenEntry tarPath linkTarget -> String
$cshowsPrec :: forall tarPath linkTarget.
(Show tarPath, Show linkTarget) =>
Int -> GenEntry tarPath linkTarget -> ShowS
showsPrec :: Int -> GenEntry tarPath linkTarget -> ShowS
$cshow :: forall tarPath linkTarget.
(Show tarPath, Show linkTarget) =>
GenEntry tarPath linkTarget -> String
show :: GenEntry tarPath linkTarget -> String
$cshowList :: forall tarPath linkTarget.
(Show tarPath, Show linkTarget) =>
[GenEntry tarPath linkTarget] -> ShowS
showList :: [GenEntry tarPath linkTarget] -> ShowS
Show)

-- | Monomorphic tar archive entry, ready for serialization / deserialization.
--
type Entry = GenEntry TarPath LinkTarget

-- | Low-level function to get a native 'FilePath' of the file or directory
-- within the archive, not accounting for long names. It's likely
-- that you want to apply 'Codec.Archive.Tar.decodeLongNames'
-- and use 'Codec.Archive.Tar.Entry.entryTarPath' afterwards instead of 'entryPath'.
--
entryPath :: GenEntry TarPath linkTarget -> FilePath
entryPath :: forall linkTarget. GenEntry TarPath linkTarget -> String
entryPath = TarPath -> String
fromTarPath (TarPath -> String)
-> (GenEntry TarPath linkTarget -> TarPath)
-> GenEntry TarPath linkTarget
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenEntry TarPath linkTarget -> TarPath
forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
entryTarPath

-- | Polymorphic content of a tar archive entry. High-level interfaces
-- commonly work with 'GenEntryContent' 'FilePath',
-- while low-level ones use 'GenEntryContent' t'LinkTarget'.
--
-- Portable archives should contain only 'NormalFile' and 'Directory'.
--
-- @since 0.6.0.0
data GenEntryContent linkTarget
  = NormalFile      LBS.ByteString {-# UNPACK #-} !FileSize
  | Directory
  | SymbolicLink    !linkTarget
  | HardLink        !linkTarget
  | CharacterDevice {-# UNPACK #-} !DevMajor
                    {-# UNPACK #-} !DevMinor
  | BlockDevice     {-# UNPACK #-} !DevMajor
                    {-# UNPACK #-} !DevMinor
  | NamedPipe
  | OtherEntryType  {-# UNPACK #-} !TypeCode LBS.ByteString
                    {-# UNPACK #-} !FileSize
  deriving (GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
(GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool)
-> (GenEntryContent linkTarget
    -> GenEntryContent linkTarget -> Bool)
-> Eq (GenEntryContent linkTarget)
forall linkTarget.
Eq linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall linkTarget.
Eq linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
== :: GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
$c/= :: forall linkTarget.
Eq linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
/= :: GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
Eq, Eq (GenEntryContent linkTarget)
Eq (GenEntryContent linkTarget) =>
(GenEntryContent linkTarget
 -> GenEntryContent linkTarget -> Ordering)
-> (GenEntryContent linkTarget
    -> GenEntryContent linkTarget -> Bool)
-> (GenEntryContent linkTarget
    -> GenEntryContent linkTarget -> Bool)
-> (GenEntryContent linkTarget
    -> GenEntryContent linkTarget -> Bool)
-> (GenEntryContent linkTarget
    -> GenEntryContent linkTarget -> Bool)
-> (GenEntryContent linkTarget
    -> GenEntryContent linkTarget -> GenEntryContent linkTarget)
-> (GenEntryContent linkTarget
    -> GenEntryContent linkTarget -> GenEntryContent linkTarget)
-> Ord (GenEntryContent linkTarget)
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
GenEntryContent linkTarget
-> GenEntryContent linkTarget -> Ordering
GenEntryContent linkTarget
-> GenEntryContent linkTarget -> GenEntryContent linkTarget
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall linkTarget.
Ord linkTarget =>
Eq (GenEntryContent linkTarget)
forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget
-> GenEntryContent linkTarget -> Ordering
forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget
-> GenEntryContent linkTarget -> GenEntryContent linkTarget
$ccompare :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget
-> GenEntryContent linkTarget -> Ordering
compare :: GenEntryContent linkTarget
-> GenEntryContent linkTarget -> Ordering
$c< :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
< :: GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
$c<= :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
<= :: GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
$c> :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
> :: GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
$c>= :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
>= :: GenEntryContent linkTarget -> GenEntryContent linkTarget -> Bool
$cmax :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget
-> GenEntryContent linkTarget -> GenEntryContent linkTarget
max :: GenEntryContent linkTarget
-> GenEntryContent linkTarget -> GenEntryContent linkTarget
$cmin :: forall linkTarget.
Ord linkTarget =>
GenEntryContent linkTarget
-> GenEntryContent linkTarget -> GenEntryContent linkTarget
min :: GenEntryContent linkTarget
-> GenEntryContent linkTarget -> GenEntryContent linkTarget
Ord, Int -> GenEntryContent linkTarget -> ShowS
[GenEntryContent linkTarget] -> ShowS
GenEntryContent linkTarget -> String
(Int -> GenEntryContent linkTarget -> ShowS)
-> (GenEntryContent linkTarget -> String)
-> ([GenEntryContent linkTarget] -> ShowS)
-> Show (GenEntryContent linkTarget)
forall linkTarget.
Show linkTarget =>
Int -> GenEntryContent linkTarget -> ShowS
forall linkTarget.
Show linkTarget =>
[GenEntryContent linkTarget] -> ShowS
forall linkTarget.
Show linkTarget =>
GenEntryContent linkTarget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall linkTarget.
Show linkTarget =>
Int -> GenEntryContent linkTarget -> ShowS
showsPrec :: Int -> GenEntryContent linkTarget -> ShowS
$cshow :: forall linkTarget.
Show linkTarget =>
GenEntryContent linkTarget -> String
show :: GenEntryContent linkTarget -> String
$cshowList :: forall linkTarget.
Show linkTarget =>
[GenEntryContent linkTarget] -> ShowS
showList :: [GenEntryContent linkTarget] -> ShowS
Show)

-- | Monomorphic content of a tar archive entry,
-- ready for serialization / deserialization.
type EntryContent = GenEntryContent LinkTarget

-- | Ownership information for 'GenEntry'.
data Ownership = Ownership {
    -- | The owner user name. Should be set to @\"\"@ if unknown.
    -- Must not contain non-ASCII characters.
    Ownership -> String
ownerName :: String,

    -- | The owner group name. Should be set to @\"\"@ if unknown.
    -- Must not contain non-ASCII characters.
    Ownership -> String
groupName :: String,

    -- | Numeric owner user id. Should be set to @0@ if unknown.
    Ownership -> Int
ownerId :: {-# UNPACK #-} !Int,

    -- | Numeric owner group id. Should be set to @0@ if unknown.
    Ownership -> Int
groupId :: {-# UNPACK #-} !Int
  }
    deriving (Ownership -> Ownership -> Bool
(Ownership -> Ownership -> Bool)
-> (Ownership -> Ownership -> Bool) -> Eq Ownership
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ownership -> Ownership -> Bool
== :: Ownership -> Ownership -> Bool
$c/= :: Ownership -> Ownership -> Bool
/= :: Ownership -> Ownership -> Bool
Eq, Eq Ownership
Eq Ownership =>
(Ownership -> Ownership -> Ordering)
-> (Ownership -> Ownership -> Bool)
-> (Ownership -> Ownership -> Bool)
-> (Ownership -> Ownership -> Bool)
-> (Ownership -> Ownership -> Bool)
-> (Ownership -> Ownership -> Ownership)
-> (Ownership -> Ownership -> Ownership)
-> Ord Ownership
Ownership -> Ownership -> Bool
Ownership -> Ownership -> Ordering
Ownership -> Ownership -> Ownership
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Ownership -> Ownership -> Ordering
compare :: Ownership -> Ownership -> Ordering
$c< :: Ownership -> Ownership -> Bool
< :: Ownership -> Ownership -> Bool
$c<= :: Ownership -> Ownership -> Bool
<= :: Ownership -> Ownership -> Bool
$c> :: Ownership -> Ownership -> Bool
> :: Ownership -> Ownership -> Bool
$c>= :: Ownership -> Ownership -> Bool
>= :: Ownership -> Ownership -> Bool
$cmax :: Ownership -> Ownership -> Ownership
max :: Ownership -> Ownership -> Ownership
$cmin :: Ownership -> Ownership -> Ownership
min :: Ownership -> Ownership -> Ownership
Ord, Int -> Ownership -> ShowS
[Ownership] -> ShowS
Ownership -> String
(Int -> Ownership -> ShowS)
-> (Ownership -> String)
-> ([Ownership] -> ShowS)
-> Show Ownership
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ownership -> ShowS
showsPrec :: Int -> Ownership -> ShowS
$cshow :: Ownership -> String
show :: Ownership -> String
$cshowList :: [Ownership] -> ShowS
showList :: [Ownership] -> ShowS
Show)

-- | There have been a number of extensions to the tar file format over the
-- years. They all share the basic entry fields and put more meta-data in
-- different extended headers.
--
data Format =

     -- | This is the classic Unix V7 tar format. It does not support owner and
     -- group names, just numeric Ids. It also does not support device numbers.
     V7Format

     -- | The \"USTAR\" format is an extension of the classic V7 format. It was
     -- later standardised by POSIX. It has some restrictions but is the most
     -- portable format.
   | UstarFormat

     -- | The GNU tar implementation also extends the classic V7 format, though
     -- in a slightly different way from the USTAR format. This is the only format
     -- supporting long file names.
   | GnuFormat
  deriving (Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq, Eq Format
Eq Format =>
(Format -> Format -> Ordering)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Format)
-> (Format -> Format -> Format)
-> Ord Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Format -> Format -> Ordering
compare :: Format -> Format -> Ordering
$c< :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
>= :: Format -> Format -> Bool
$cmax :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
min :: Format -> Format -> Format
Ord, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Format -> ShowS
showsPrec :: Int -> Format -> ShowS
$cshow :: Format -> String
show :: Format -> String
$cshowList :: [Format] -> ShowS
showList :: [Format] -> ShowS
Show)

instance (NFData tarPath, NFData linkTarget) => NFData (GenEntry tarPath linkTarget) where
  rnf :: GenEntry tarPath linkTarget -> ()
rnf (Entry tarPath
p GenEntryContent linkTarget
c Permissions
_ Ownership
_ EpochTime
_ Format
_) = tarPath -> ()
forall a. NFData a => a -> ()
rnf tarPath
p () -> () -> ()
forall a b. a -> b -> b
`seq` GenEntryContent linkTarget -> ()
forall a. NFData a => a -> ()
rnf GenEntryContent linkTarget
c

instance NFData linkTarget => NFData (GenEntryContent linkTarget) where
  rnf :: GenEntryContent linkTarget -> ()
rnf GenEntryContent linkTarget
x = case GenEntryContent linkTarget
x of
      NormalFile       ByteString
c EpochTime
_  -> ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
c
      SymbolicLink linkTarget
lnk      -> linkTarget -> ()
forall a. NFData a => a -> ()
rnf linkTarget
lnk
      HardLink linkTarget
lnk          -> linkTarget -> ()
forall a. NFData a => a -> ()
rnf linkTarget
lnk
      OtherEntryType Char
_ ByteString
c EpochTime
_  -> ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
c
      GenEntryContent linkTarget
_                     -> GenEntryContent linkTarget -> () -> ()
forall a b. a -> b -> b
seq GenEntryContent linkTarget
x ()

instance NFData Ownership where
  rnf :: Ownership -> ()
rnf (Ownership String
o String
g Int
_ Int
_) = String -> ()
forall a. NFData a => a -> ()
rnf String
o () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
g

-- | @rw-r--r--@ for normal files
ordinaryFilePermissions :: Permissions
ordinaryFilePermissions :: Permissions
ordinaryFilePermissions   = Permissions
0o0644

-- | @rw-r--r--@ for normal files
--
-- @since 0.6.0.0
symbolicLinkPermission :: Permissions
symbolicLinkPermission :: Permissions
symbolicLinkPermission   = Permissions
0o0777

-- | @rwxr-xr-x@ for executable files
executableFilePermissions :: Permissions
executableFilePermissions :: Permissions
executableFilePermissions = Permissions
0o0755

-- | @rwxr-xr-x@ for directories
directoryPermissions :: Permissions
directoryPermissions :: Permissions
directoryPermissions  = Permissions
0o0755

-- | An entry with all default values except for the file name and type. It
-- uses the portable USTAR/POSIX format (see 'UstarFormat').
--
-- You can use this as a basis and override specific fields, eg:
--
-- > (emptyEntry name HardLink) { linkTarget = target }
--
simpleEntry :: tarPath -> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
simpleEntry :: forall tarPath linkTarget.
tarPath
-> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
simpleEntry tarPath
tarpath GenEntryContent linkTarget
content = Entry {
    entryTarPath :: tarPath
entryTarPath     = tarPath
tarpath,
    entryContent :: GenEntryContent linkTarget
entryContent     = GenEntryContent linkTarget
content,
    entryPermissions :: Permissions
entryPermissions = case GenEntryContent linkTarget
content of
                         GenEntryContent linkTarget
Directory -> Permissions
directoryPermissions
                         SymbolicLink linkTarget
_ -> Permissions
symbolicLinkPermission
                         GenEntryContent linkTarget
_         -> Permissions
ordinaryFilePermissions,
    entryOwnership :: Ownership
entryOwnership   = String -> String -> Int -> Int -> Ownership
Ownership String
"" String
"" Int
0 Int
0,
    entryTime :: EpochTime
entryTime        = EpochTime
0,
    entryFormat :: Format
entryFormat      = Format
UstarFormat
  }

-- | A tar entry for a file.
--
-- Entry  fields such as file permissions and ownership have default values.
--
-- You can use this as a basis and override specific fields. For example if you
-- need an executable file you could use:
--
-- > (fileEntry name content) { fileMode = executableFileMode }
--
fileEntry :: tarPath -> LBS.ByteString -> GenEntry tarPath linkTarget
fileEntry :: forall tarPath linkTarget.
tarPath -> ByteString -> GenEntry tarPath linkTarget
fileEntry tarPath
name ByteString
fileContent =
  tarPath
-> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
forall tarPath linkTarget.
tarPath
-> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
simpleEntry tarPath
name (ByteString -> EpochTime -> GenEntryContent linkTarget
forall linkTarget.
ByteString -> EpochTime -> GenEntryContent linkTarget
NormalFile ByteString
fileContent (ByteString -> EpochTime
LBS.length ByteString
fileContent))

-- | A tar entry for a symbolic link.
symlinkEntry :: tarPath -> linkTarget -> GenEntry tarPath linkTarget
symlinkEntry :: forall tarPath linkTarget.
tarPath -> linkTarget -> GenEntry tarPath linkTarget
symlinkEntry tarPath
name linkTarget
targetLink =
  tarPath
-> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
forall tarPath linkTarget.
tarPath
-> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
simpleEntry tarPath
name (linkTarget -> GenEntryContent linkTarget
forall linkTarget. linkTarget -> GenEntryContent linkTarget
SymbolicLink linkTarget
targetLink)

-- | [GNU extension](https://www.gnu.org/software/tar/manual/html_node/Standard.html)
-- to store a filepath too long to fit into 'Codec.Archive.Tar.Entry.entryTarPath'
-- as 'OtherEntryType' @\'L\'@ with the full filepath as 'entryContent'.
-- The next entry must contain the actual
-- data with truncated 'Codec.Archive.Tar.Entry.entryTarPath'.
--
-- See [What exactly is the GNU tar ././@LongLink "trick"?](https://stackoverflow.com/questions/2078778/what-exactly-is-the-gnu-tar-longlink-trick)
--
-- @since 0.6.0.0
longLinkEntry :: FilePath -> GenEntry TarPath linkTarget
longLinkEntry :: forall linkTarget. String -> GenEntry TarPath linkTarget
longLinkEntry String
tarpath = Entry {
    entryTarPath :: TarPath
entryTarPath     = PosixString -> PosixString -> TarPath
TarPath [PS.pstr|././@LongLink|] PosixString
forall a. Monoid a => a
mempty,
    entryContent :: GenEntryContent linkTarget
entryContent     = Char -> ByteString -> EpochTime -> GenEntryContent linkTarget
forall linkTarget.
Char -> ByteString -> EpochTime -> GenEntryContent linkTarget
OtherEntryType Char
'L' (ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ PosixString -> ByteString
posixToByteString (PosixString -> ByteString) -> PosixString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> PosixString
toPosixString String
tarpath) (Int -> EpochTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> EpochTime) -> Int -> EpochTime
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tarpath),
    entryPermissions :: Permissions
entryPermissions = Permissions
ordinaryFilePermissions,
    entryOwnership :: Ownership
entryOwnership   = String -> String -> Int -> Int -> Ownership
Ownership String
"" String
"" Int
0 Int
0,
    entryTime :: EpochTime
entryTime        = EpochTime
0,
    entryFormat :: Format
entryFormat      = Format
GnuFormat
  }

-- | [GNU extension](https://www.gnu.org/software/tar/manual/html_node/Standard.html)
-- to store a link target too long to fit into 'Codec.Archive.Tar.Entry.entryTarPath'
-- as 'OtherEntryType' @\'K\'@ with the full filepath as 'entryContent'.
-- The next entry must contain the actual
-- data with truncated 'Codec.Archive.Tar.Entry.entryTarPath'.
--
-- @since 0.6.0.0
longSymLinkEntry :: FilePath -> GenEntry TarPath linkTarget
longSymLinkEntry :: forall linkTarget. String -> GenEntry TarPath linkTarget
longSymLinkEntry String
linkTarget = Entry {
    entryTarPath :: TarPath
entryTarPath     = PosixString -> PosixString -> TarPath
TarPath [PS.pstr|././@LongLink|] PosixString
forall a. Monoid a => a
mempty,
    entryContent :: GenEntryContent linkTarget
entryContent     = Char -> ByteString -> EpochTime -> GenEntryContent linkTarget
forall linkTarget.
Char -> ByteString -> EpochTime -> GenEntryContent linkTarget
OtherEntryType Char
'K' (ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ PosixString -> ByteString
posixToByteString (PosixString -> ByteString) -> PosixString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> PosixString
toPosixString (String -> PosixString) -> String -> PosixString
forall a b. (a -> b) -> a -> b
$ String
linkTarget) (Int -> EpochTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> EpochTime) -> Int -> EpochTime
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
linkTarget),
    entryPermissions :: Permissions
entryPermissions = Permissions
ordinaryFilePermissions,
    entryOwnership :: Ownership
entryOwnership   = String -> String -> Int -> Int -> Ownership
Ownership String
"" String
"" Int
0 Int
0,
    entryTime :: EpochTime
entryTime        = EpochTime
0,
    entryFormat :: Format
entryFormat      = Format
GnuFormat
  }

-- | A tar entry for a directory.
--
-- Entry fields such as file permissions and ownership have default values.
--
directoryEntry :: tarPath -> GenEntry tarPath linkTarget
directoryEntry :: forall tarPath linkTarget. tarPath -> GenEntry tarPath linkTarget
directoryEntry tarPath
name = tarPath
-> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
forall tarPath linkTarget.
tarPath
-> GenEntryContent linkTarget -> GenEntry tarPath linkTarget
simpleEntry tarPath
name GenEntryContent linkTarget
forall linkTarget. GenEntryContent linkTarget
Directory

--
-- * Tar paths
--

-- | The classic tar format allowed just 100 characters for the file name. The
-- USTAR format extended this with an extra 155 characters, however it uses a
-- complex method of splitting the name between the two sections.
--
-- Instead of just putting any overflow into the extended area, it uses the
-- extended area as a prefix. The aggravating insane bit however is that the
-- prefix (if any) must only contain a directory prefix. That is the split
-- between the two areas must be on a directory separator boundary. So there is
-- no simple calculation to work out if a file name is too long. Instead we
-- have to try to find a valid split that makes the name fit in the two areas.
--
-- The rationale presumably was to make it a bit more compatible with old tar
-- programs that only understand the classic format. A classic tar would be
-- able to extract the file name and possibly some dir prefix, but not the
-- full dir prefix. So the files would end up in the wrong place, but that's
-- probably better than ending up with the wrong names too.
--
-- So it's understandable but rather annoying.
--
-- * Tar paths use Posix format (ie @\'/\'@ directory separators), irrespective
--   of the local path conventions.
--
-- * The directory separator between the prefix and name is /not/ stored.
--
data TarPath = TarPath
  {-# UNPACK #-} !PosixString
  -- ^ path name, 100 characters max.
  {-# UNPACK #-} !PosixString
  -- ^ path prefix, 155 characters max.
  deriving (TarPath -> TarPath -> Bool
(TarPath -> TarPath -> Bool)
-> (TarPath -> TarPath -> Bool) -> Eq TarPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TarPath -> TarPath -> Bool
== :: TarPath -> TarPath -> Bool
$c/= :: TarPath -> TarPath -> Bool
/= :: TarPath -> TarPath -> Bool
Eq, Eq TarPath
Eq TarPath =>
(TarPath -> TarPath -> Ordering)
-> (TarPath -> TarPath -> Bool)
-> (TarPath -> TarPath -> Bool)
-> (TarPath -> TarPath -> Bool)
-> (TarPath -> TarPath -> Bool)
-> (TarPath -> TarPath -> TarPath)
-> (TarPath -> TarPath -> TarPath)
-> Ord TarPath
TarPath -> TarPath -> Bool
TarPath -> TarPath -> Ordering
TarPath -> TarPath -> TarPath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TarPath -> TarPath -> Ordering
compare :: TarPath -> TarPath -> Ordering
$c< :: TarPath -> TarPath -> Bool
< :: TarPath -> TarPath -> Bool
$c<= :: TarPath -> TarPath -> Bool
<= :: TarPath -> TarPath -> Bool
$c> :: TarPath -> TarPath -> Bool
> :: TarPath -> TarPath -> Bool
$c>= :: TarPath -> TarPath -> Bool
>= :: TarPath -> TarPath -> Bool
$cmax :: TarPath -> TarPath -> TarPath
max :: TarPath -> TarPath -> TarPath
$cmin :: TarPath -> TarPath -> TarPath
min :: TarPath -> TarPath -> TarPath
Ord)

instance NFData TarPath where
  rnf :: TarPath -> ()
rnf (TarPath PosixString
_ PosixString
_) = () -- fully strict by construction

instance Show TarPath where
  show :: TarPath -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (TarPath -> String) -> TarPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TarPath -> String
fromTarPath

-- | Convert a t'TarPath' to a native 'FilePath'.
--
-- The native 'FilePath' will use the native directory separator but it is not
-- otherwise checked for validity or sanity. In particular:
--
-- * The tar path may be invalid as a native path, eg the file name @\"nul\"@
--   is not valid on Windows.
--
-- * The tar path may be an absolute path or may contain @\"..\"@ components.
--   For security reasons this should not usually be allowed, but it is your
--   responsibility to check for these conditions
--   (e.g., using 'Codec.Archive.Tar.Check.checkEntrySecurity').
--
fromTarPath :: TarPath -> FilePath
fromTarPath :: TarPath -> String
fromTarPath = PosixString -> String
fromPosixString (PosixString -> String)
-> (TarPath -> PosixString) -> TarPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixChar -> TarPath -> PosixString
fromTarPathInternal (Char -> PosixChar
PS.unsafeFromChar Char
FilePath.Native.pathSeparator)

-- | Convert a t'TarPath' to a Unix\/Posix 'FilePath'.
--
-- The difference compared to 'fromTarPath' is that it always returns a Unix
-- style path irrespective of the current operating system.
--
-- This is useful to check how a t'TarPath' would be interpreted on a specific
-- operating system, eg to perform portability checks.
--
fromTarPathToPosixPath :: TarPath -> FilePath
fromTarPathToPosixPath :: TarPath -> String
fromTarPathToPosixPath = PosixString -> String
fromPosixString (PosixString -> String)
-> (TarPath -> PosixString) -> TarPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixChar -> TarPath -> PosixString
fromTarPathInternal (Char -> PosixChar
PS.unsafeFromChar Char
FilePath.Posix.pathSeparator)

-- | Convert a t'TarPath' to a Windows 'FilePath'.
--
-- The only difference compared to 'fromTarPath' is that it always returns a
-- Windows style path irrespective of the current operating system.
--
-- This is useful to check how a t'TarPath' would be interpreted on a specific
-- operating system, eg to perform portability checks.
--
fromTarPathToWindowsPath :: TarPath -> FilePath
fromTarPathToWindowsPath :: TarPath -> String
fromTarPathToWindowsPath = PosixString -> String
fromPosixString (PosixString -> String)
-> (TarPath -> PosixString) -> TarPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixChar -> TarPath -> PosixString
fromTarPathInternal (Char -> PosixChar
PS.unsafeFromChar Char
FilePath.Windows.pathSeparator)

fromTarPathInternal :: PosixChar -> TarPath -> PosixString
fromTarPathInternal :: PosixChar -> TarPath -> PosixString
fromTarPathInternal PosixChar
sep = TarPath -> PosixString
go
  where
    posixSep :: PosixChar
posixSep = Char -> PosixChar
PS.unsafeFromChar Char
FilePath.Posix.pathSeparator
    adjustSeps :: PosixString -> PosixString
adjustSeps = if PosixChar
sep PosixChar -> PosixChar -> Bool
forall a. Eq a => a -> a -> Bool
== PosixChar
posixSep then PosixString -> PosixString
forall a. a -> a
id else
      (PosixChar -> PosixChar) -> PosixString -> PosixString
PS.map ((PosixChar -> PosixChar) -> PosixString -> PosixString)
-> (PosixChar -> PosixChar) -> PosixString -> PosixString
forall a b. (a -> b) -> a -> b
$ \PosixChar
c -> if PosixChar
c PosixChar -> PosixChar -> Bool
forall a. Eq a => a -> a -> Bool
== PosixChar
posixSep then PosixChar
sep else PosixChar
c
    go :: TarPath -> PosixString
go (TarPath PosixString
name PosixString
prefix)
     | PosixString -> Bool
PS.null PosixString
prefix = PosixString -> PosixString
adjustSeps PosixString
name
     | PosixString -> Bool
PS.null PosixString
name = PosixString -> PosixString
adjustSeps PosixString
prefix
     | Bool
otherwise = PosixString -> PosixString
adjustSeps PosixString
prefix PosixString -> PosixString -> PosixString
forall a. Semigroup a => a -> a -> a
<> PosixChar -> PosixString -> PosixString
PS.cons PosixChar
sep (PosixString -> PosixString
adjustSeps PosixString
name)
{-# INLINE fromTarPathInternal #-}

-- | Convert a native 'FilePath' to a t'TarPath'.
--
-- The conversion may fail if the 'FilePath' is empty or too long.
toTarPath :: Bool -- ^ Is the path for a directory? This is needed because for
                  -- directories a t'TarPath' must always use a trailing @\/@.
          -> FilePath
          -> Either String TarPath
toTarPath :: Bool -> String -> Either String TarPath
toTarPath Bool
isDir String
path = case String -> ToTarPathResult
toTarPath' String
path' of
  ToTarPathResult
FileNameEmpty      -> String -> Either String TarPath
forall a b. a -> Either a b
Left String
"File name empty"
  FileNameOK TarPath
tarPath -> TarPath -> Either String TarPath
forall a b. b -> Either a b
Right TarPath
tarPath
  FileNameTooLong{}  -> String -> Either String TarPath
forall a b. a -> Either a b
Left String
"File name too long"
  where
    path' :: String
path' = if Bool
isDir Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
FilePath.Native.hasTrailingPathSeparator String
path)
            then String
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
FilePath.Native.pathSeparator]
            else String
path

-- | Convert a native 'FilePath' to a t'TarPath'.
-- Directory paths must always have a trailing @\/@, this is not checked.
--
-- @since 0.6.0.0
toTarPath'
  :: FilePath
  -> ToTarPathResult
toTarPath' :: String -> ToTarPathResult
toTarPath'
  = String -> ToTarPathResult
splitLongPath
  (String -> ToTarPathResult) -> ShowS -> String -> ToTarPathResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Char
nativeSep Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
posixSep then ShowS
forall a. a -> a
id else ShowS
adjustSeps)
  where
    nativeSep :: Char
nativeSep = Char
FilePath.Native.pathSeparator
    posixSep :: Char
posixSep = Char
FilePath.Posix.pathSeparator
    adjustSeps :: ShowS
adjustSeps = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> ShowS) -> (Char -> Char) -> ShowS
forall a b. (a -> b) -> a -> b
$ \Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
nativeSep then Char
posixSep else Char
c

-- | Return type of 'toTarPath''.
--
-- @since 0.6.0.0
data ToTarPathResult
  = FileNameEmpty
  -- ^ 'FilePath' was empty, but t'TarPath' must be non-empty.
  | FileNameOK TarPath
  -- ^ All good, this is just a normal t'TarPath'.
  | FileNameTooLong TarPath
  -- ^ 'FilePath' was longer than 255 characters, t'TarPath' contains
  -- a truncated part only. An actual entry must be preceded by
  -- 'longLinkEntry'.

-- | Take a sanitised path, split on directory separators and try to pack it
-- into the 155 + 100 tar file name format.
--
-- The strategy is this: take the name-directory components in reverse order
-- and try to fit as many components into the 100 long name area as possible.
-- If all the remaining components fit in the 155 name area then we win.
splitLongPath :: FilePath -> ToTarPathResult
splitLongPath :: String -> ToTarPathResult
splitLongPath String
path = case [String] -> [String]
forall a. [a] -> [a]
reverse (String -> [String]
FilePath.Posix.splitPath String
path) of
  [] -> ToTarPathResult
FileNameEmpty
  String
c : [String]
cs -> case Int -> NonEmpty String -> Maybe (String, [String])
packName Int
nameMax (String
c String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [String]
cs) of
    Maybe (String, [String])
Nothing                 -> TarPath -> ToTarPathResult
FileNameTooLong (TarPath -> ToTarPathResult) -> TarPath -> ToTarPathResult
forall a b. (a -> b) -> a -> b
$ PosixString -> PosixString -> TarPath
TarPath (String -> PosixString
toPosixString (String -> PosixString) -> String -> PosixString
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
100 String
path) PosixString
forall a. Monoid a => a
mempty
    Just (String
name, [])         -> TarPath -> ToTarPathResult
FileNameOK (TarPath -> ToTarPathResult) -> TarPath -> ToTarPathResult
forall a b. (a -> b) -> a -> b
$! PosixString -> PosixString -> TarPath
TarPath (String -> PosixString
toPosixString String
name) PosixString
forall a. Monoid a => a
mempty
    Just (String
name, String
first:[String]
rest) -> case Int -> NonEmpty String -> Maybe (String, [String])
packName Int
prefixMax NonEmpty String
remainder of
      Maybe (String, [String])
Nothing               -> TarPath -> ToTarPathResult
FileNameTooLong (TarPath -> ToTarPathResult) -> TarPath -> ToTarPathResult
forall a b. (a -> b) -> a -> b
$ PosixString -> PosixString -> TarPath
TarPath (String -> PosixString
toPosixString (String -> PosixString) -> String -> PosixString
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
100 String
path) PosixString
forall a. Monoid a => a
mempty
      Just (String
_     , String
_:[String]
_)    -> TarPath -> ToTarPathResult
FileNameTooLong (TarPath -> ToTarPathResult) -> TarPath -> ToTarPathResult
forall a b. (a -> b) -> a -> b
$ PosixString -> PosixString -> TarPath
TarPath (String -> PosixString
toPosixString (String -> PosixString) -> String -> PosixString
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
100 String
path) PosixString
forall a. Monoid a => a
mempty
      Just (String
prefix, [])     -> TarPath -> ToTarPathResult
FileNameOK (TarPath -> ToTarPathResult) -> TarPath -> ToTarPathResult
forall a b. (a -> b) -> a -> b
$! PosixString -> PosixString -> TarPath
TarPath (String -> PosixString
toPosixString String
name) (String -> PosixString
toPosixString String
prefix)
      where
        -- drop the '/' between the name and prefix:
        remainder :: NonEmpty String
remainder = ShowS
forall a. HasCallStack => [a] -> [a]
init String
first String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [String]
rest

  where
    nameMax, prefixMax :: Int
    nameMax :: Int
nameMax   = Int
100
    prefixMax :: Int
prefixMax = Int
155

    packName :: Int -> NonEmpty FilePath -> Maybe (FilePath, [FilePath])
    packName :: Int -> NonEmpty String -> Maybe (String, [String])
packName Int
maxLen (String
c :| [String]
cs)
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLen         = Maybe (String, [String])
forall a. Maybe a
Nothing
      | Bool
otherwise          = (String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (Int -> Int -> [String] -> [String] -> (String, [String])
packName' Int
maxLen Int
n [String
c] [String]
cs)
      where n :: Int
n = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c

    packName' :: Int -> Int -> [FilePath] -> [FilePath] -> (FilePath, [FilePath])
    packName' :: Int -> Int -> [String] -> [String] -> (String, [String])
packName' Int
maxLen Int
n [String]
ok (String
c:[String]
cs)
      | Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxLen             = Int -> Int -> [String] -> [String] -> (String, [String])
packName' Int
maxLen Int
n' (String
cString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ok) [String]
cs
                                     where n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c
    packName' Int
_      Int
_ [String]
ok    [String]
cs  = ([String] -> String
FilePath.Posix.joinPath [String]
ok, [String]
cs)

-- | The tar format allows just 100 ASCII characters for the 'SymbolicLink' and
-- 'HardLink' entry types.
--
newtype LinkTarget = LinkTarget PosixString
  deriving (LinkTarget -> LinkTarget -> Bool
(LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool) -> Eq LinkTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LinkTarget -> LinkTarget -> Bool
== :: LinkTarget -> LinkTarget -> Bool
$c/= :: LinkTarget -> LinkTarget -> Bool
/= :: LinkTarget -> LinkTarget -> Bool
Eq, Eq LinkTarget
Eq LinkTarget =>
(LinkTarget -> LinkTarget -> Ordering)
-> (LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> LinkTarget)
-> (LinkTarget -> LinkTarget -> LinkTarget)
-> Ord LinkTarget
LinkTarget -> LinkTarget -> Bool
LinkTarget -> LinkTarget -> Ordering
LinkTarget -> LinkTarget -> LinkTarget
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LinkTarget -> LinkTarget -> Ordering
compare :: LinkTarget -> LinkTarget -> Ordering
$c< :: LinkTarget -> LinkTarget -> Bool
< :: LinkTarget -> LinkTarget -> Bool
$c<= :: LinkTarget -> LinkTarget -> Bool
<= :: LinkTarget -> LinkTarget -> Bool
$c> :: LinkTarget -> LinkTarget -> Bool
> :: LinkTarget -> LinkTarget -> Bool
$c>= :: LinkTarget -> LinkTarget -> Bool
>= :: LinkTarget -> LinkTarget -> Bool
$cmax :: LinkTarget -> LinkTarget -> LinkTarget
max :: LinkTarget -> LinkTarget -> LinkTarget
$cmin :: LinkTarget -> LinkTarget -> LinkTarget
min :: LinkTarget -> LinkTarget -> LinkTarget
Ord, Int -> LinkTarget -> ShowS
[LinkTarget] -> ShowS
LinkTarget -> String
(Int -> LinkTarget -> ShowS)
-> (LinkTarget -> String)
-> ([LinkTarget] -> ShowS)
-> Show LinkTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkTarget -> ShowS
showsPrec :: Int -> LinkTarget -> ShowS
$cshow :: LinkTarget -> String
show :: LinkTarget -> String
$cshowList :: [LinkTarget] -> ShowS
showList :: [LinkTarget] -> ShowS
Show)

instance NFData LinkTarget where
    rnf :: LinkTarget -> ()
rnf (LinkTarget PosixString
bs) = PosixString -> ()
forall a. NFData a => a -> ()
rnf PosixString
bs

-- | Convert a native 'FilePath' to a tar t'LinkTarget'.
-- string is longer than 100 characters or if it contains non-portable
-- characters.
toLinkTarget :: FilePath -> Maybe LinkTarget
toLinkTarget :: String -> Maybe LinkTarget
toLinkTarget String
path
  | String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
path Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100 = do
    String
target <- String -> Maybe String
toLinkTarget' String
path
    LinkTarget -> Maybe LinkTarget
forall a. a -> Maybe a
Just (LinkTarget -> Maybe LinkTarget) -> LinkTarget -> Maybe LinkTarget
forall a b. (a -> b) -> a -> b
$! PosixString -> LinkTarget
LinkTarget (String -> PosixString
toPosixString String
target)
  | Bool
otherwise = Maybe LinkTarget
forall a. Maybe a
Nothing

data LinkTargetException = IsAbsolute FilePath
                         | TooLong FilePath
  deriving (Int -> LinkTargetException -> ShowS
[LinkTargetException] -> ShowS
LinkTargetException -> String
(Int -> LinkTargetException -> ShowS)
-> (LinkTargetException -> String)
-> ([LinkTargetException] -> ShowS)
-> Show LinkTargetException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkTargetException -> ShowS
showsPrec :: Int -> LinkTargetException -> ShowS
$cshow :: LinkTargetException -> String
show :: LinkTargetException -> String
$cshowList :: [LinkTargetException] -> ShowS
showList :: [LinkTargetException] -> ShowS
Show,Typeable)

instance Exception LinkTargetException where
  displayException :: LinkTargetException -> String
displayException (IsAbsolute String
fp) = String
"Link target \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\" is unexpectedly absolute"
  displayException (TooLong String
_) = String
"The link target is too long"

-- | Convert a native 'FilePath' to a unix filepath suitable for
-- using as t'LinkTarget'. Does not error if longer than 100 characters.
toLinkTarget' :: FilePath -> Maybe FilePath
toLinkTarget' :: String -> Maybe String
toLinkTarget' String
path
  | String -> Bool
FilePath.Native.isAbsolute String
path = Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ShowS
adjustDirectory ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
FilePath.Posix.joinPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Native.splitDirectories String
path
  where
    adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Native.hasTrailingPathSeparator String
path
                    = ShowS
FilePath.Posix.addTrailingPathSeparator
                    | Bool
otherwise = ShowS
forall a. a -> a
id

-- | Convert a tar t'LinkTarget' to a native 'FilePath'.
fromLinkTarget :: LinkTarget -> FilePath
fromLinkTarget :: LinkTarget -> String
fromLinkTarget (LinkTarget PosixString
pathbs) = ShowS
fromFilePathToNative ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PosixString -> String
fromPosixString PosixString
pathbs

-- | Convert a tar t'LinkTarget' to a Unix\/POSIX 'FilePath' (@\'/\'@ path separators).
fromLinkTargetToPosixPath :: LinkTarget -> FilePath
fromLinkTargetToPosixPath :: LinkTarget -> String
fromLinkTargetToPosixPath (LinkTarget PosixString
pathbs) = PosixString -> String
fromPosixString PosixString
pathbs

-- | Convert a tar t'LinkTarget' to a Windows 'FilePath' (@\'\\\\\'@ path separators).
fromLinkTargetToWindowsPath :: LinkTarget -> FilePath
fromLinkTargetToWindowsPath :: LinkTarget -> String
fromLinkTargetToWindowsPath (LinkTarget PosixString
pathbs) =
  ShowS
fromFilePathToWindowsPath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PosixString -> String
fromPosixString PosixString
pathbs

-- | Convert a unix FilePath to a native 'FilePath'.
fromFilePathToNative :: FilePath -> FilePath
fromFilePathToNative :: ShowS
fromFilePathToNative =
  Char -> Char -> ShowS
fromFilePathInternal Char
FilePath.Posix.pathSeparator Char
FilePath.Native.pathSeparator

-- | Convert a unix FilePath to a Windows 'FilePath'.
fromFilePathToWindowsPath :: FilePath -> FilePath
fromFilePathToWindowsPath :: ShowS
fromFilePathToWindowsPath =
  Char -> Char -> ShowS
fromFilePathInternal Char
FilePath.Posix.pathSeparator Char
FilePath.Windows.pathSeparator

fromFilePathInternal :: Char -> Char -> FilePath -> FilePath
fromFilePathInternal :: Char -> Char -> ShowS
fromFilePathInternal Char
fromSep Char
toSep = ShowS
adjustSeps
  where
    adjustSeps :: ShowS
adjustSeps = if Char
fromSep Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
toSep then ShowS
forall a. a -> a
id else
      (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> ShowS) -> (Char -> Char) -> ShowS
forall a b. (a -> b) -> a -> b
$ \Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
fromSep then Char
toSep else Char
c
{-# INLINE fromFilePathInternal #-}

--
-- * Entries type
--

-- | Polymorphic sequence of archive entries.
-- High-level interfaces
-- commonly work with 'GenEntries' 'FilePath' 'FilePath',
-- while low-level ones use 'GenEntries' t'TarPath' t'LinkTarget'.
--
-- The point of this type as opposed to just using a list is that it makes the
-- failure case explicit. We need this because the sequence of entries we get
-- from reading a tarball can include errors.
--
-- Converting from a list can be done with just @foldr Next Done@. Converting
-- back into a list can be done with 'foldEntries' however in that case you
-- must be prepared to handle the 'Fail' case inherent in the 'Entries' type.
--
-- The 'Monoid' instance lets you concatenate archives or append entries to an
-- archive.
--
-- @since 0.6.0.0
data GenEntries tarPath linkTarget e
  = Next (GenEntry tarPath linkTarget) (GenEntries tarPath linkTarget e)
  | Done
  | Fail e
  deriving
    ( GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e -> Bool
(GenEntries tarPath linkTarget e
 -> GenEntries tarPath linkTarget e -> Bool)
-> (GenEntries tarPath linkTarget e
    -> GenEntries tarPath linkTarget e -> Bool)
-> Eq (GenEntries tarPath linkTarget e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall tarPath linkTarget e.
(Eq tarPath, Eq linkTarget, Eq e) =>
GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e -> Bool
$c== :: forall tarPath linkTarget e.
(Eq tarPath, Eq linkTarget, Eq e) =>
GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e -> Bool
== :: GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e -> Bool
$c/= :: forall tarPath linkTarget e.
(Eq tarPath, Eq linkTarget, Eq e) =>
GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e -> Bool
/= :: GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e -> Bool
Eq
    , Int -> GenEntries tarPath linkTarget e -> ShowS
[GenEntries tarPath linkTarget e] -> ShowS
GenEntries tarPath linkTarget e -> String
(Int -> GenEntries tarPath linkTarget e -> ShowS)
-> (GenEntries tarPath linkTarget e -> String)
-> ([GenEntries tarPath linkTarget e] -> ShowS)
-> Show (GenEntries tarPath linkTarget e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall tarPath linkTarget e.
(Show tarPath, Show linkTarget, Show e) =>
Int -> GenEntries tarPath linkTarget e -> ShowS
forall tarPath linkTarget e.
(Show tarPath, Show linkTarget, Show e) =>
[GenEntries tarPath linkTarget e] -> ShowS
forall tarPath linkTarget e.
(Show tarPath, Show linkTarget, Show e) =>
GenEntries tarPath linkTarget e -> String
$cshowsPrec :: forall tarPath linkTarget e.
(Show tarPath, Show linkTarget, Show e) =>
Int -> GenEntries tarPath linkTarget e -> ShowS
showsPrec :: Int -> GenEntries tarPath linkTarget e -> ShowS
$cshow :: forall tarPath linkTarget e.
(Show tarPath, Show linkTarget, Show e) =>
GenEntries tarPath linkTarget e -> String
show :: GenEntries tarPath linkTarget e -> String
$cshowList :: forall tarPath linkTarget e.
(Show tarPath, Show linkTarget, Show e) =>
[GenEntries tarPath linkTarget e] -> ShowS
showList :: [GenEntries tarPath linkTarget e] -> ShowS
Show
    , (forall a b.
 (a -> b)
 -> GenEntries tarPath linkTarget a
 -> GenEntries tarPath linkTarget b)
-> (forall a b.
    a
    -> GenEntries tarPath linkTarget b
    -> GenEntries tarPath linkTarget a)
-> Functor (GenEntries tarPath linkTarget)
forall a b.
a
-> GenEntries tarPath linkTarget b
-> GenEntries tarPath linkTarget a
forall a b.
(a -> b)
-> GenEntries tarPath linkTarget a
-> GenEntries tarPath linkTarget b
forall tarPath linkTarget a b.
a
-> GenEntries tarPath linkTarget b
-> GenEntries tarPath linkTarget a
forall tarPath linkTarget a b.
(a -> b)
-> GenEntries tarPath linkTarget a
-> GenEntries tarPath linkTarget b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall tarPath linkTarget a b.
(a -> b)
-> GenEntries tarPath linkTarget a
-> GenEntries tarPath linkTarget b
fmap :: forall a b.
(a -> b)
-> GenEntries tarPath linkTarget a
-> GenEntries tarPath linkTarget b
$c<$ :: forall tarPath linkTarget a b.
a
-> GenEntries tarPath linkTarget b
-> GenEntries tarPath linkTarget a
<$ :: forall a b.
a
-> GenEntries tarPath linkTarget b
-> GenEntries tarPath linkTarget a
Functor
    , (forall m. Monoid m => GenEntries tarPath linkTarget m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> GenEntries tarPath linkTarget a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> GenEntries tarPath linkTarget a -> m)
-> (forall a b.
    (a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b)
-> (forall a b.
    (a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b)
-> (forall a.
    (a -> a -> a) -> GenEntries tarPath linkTarget a -> a)
-> (forall a.
    (a -> a -> a) -> GenEntries tarPath linkTarget a -> a)
-> (forall a. GenEntries tarPath linkTarget a -> [a])
-> (forall a. GenEntries tarPath linkTarget a -> Bool)
-> (forall a. GenEntries tarPath linkTarget a -> Int)
-> (forall a. Eq a => a -> GenEntries tarPath linkTarget a -> Bool)
-> (forall a. Ord a => GenEntries tarPath linkTarget a -> a)
-> (forall a. Ord a => GenEntries tarPath linkTarget a -> a)
-> (forall a. Num a => GenEntries tarPath linkTarget a -> a)
-> (forall a. Num a => GenEntries tarPath linkTarget a -> a)
-> Foldable (GenEntries tarPath linkTarget)
forall a. Eq a => a -> GenEntries tarPath linkTarget a -> Bool
forall a. Num a => GenEntries tarPath linkTarget a -> a
forall a. Ord a => GenEntries tarPath linkTarget a -> a
forall m. Monoid m => GenEntries tarPath linkTarget m -> m
forall a. GenEntries tarPath linkTarget a -> Bool
forall a. GenEntries tarPath linkTarget a -> Int
forall a. GenEntries tarPath linkTarget a -> [a]
forall a. (a -> a -> a) -> GenEntries tarPath linkTarget a -> a
forall m a.
Monoid m =>
(a -> m) -> GenEntries tarPath linkTarget a -> m
forall b a.
(b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b
forall a b.
(a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b
forall tarPath linkTarget a.
Eq a =>
a -> GenEntries tarPath linkTarget a -> Bool
forall tarPath linkTarget a.
Num a =>
GenEntries tarPath linkTarget a -> a
forall tarPath linkTarget a.
Ord a =>
GenEntries tarPath linkTarget a -> a
forall tarPath linkTarget m.
Monoid m =>
GenEntries tarPath linkTarget m -> m
forall tarPath linkTarget a.
GenEntries tarPath linkTarget a -> Bool
forall tarPath linkTarget a. GenEntries tarPath linkTarget a -> Int
forall tarPath linkTarget a. GenEntries tarPath linkTarget a -> [a]
forall tarPath linkTarget a.
(a -> a -> a) -> GenEntries tarPath linkTarget a -> a
forall tarPath linkTarget m a.
Monoid m =>
(a -> m) -> GenEntries tarPath linkTarget a -> m
forall tarPath linkTarget b a.
(b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b
forall tarPath linkTarget a b.
(a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall tarPath linkTarget m.
Monoid m =>
GenEntries tarPath linkTarget m -> m
fold :: forall m. Monoid m => GenEntries tarPath linkTarget m -> m
$cfoldMap :: forall tarPath linkTarget m a.
Monoid m =>
(a -> m) -> GenEntries tarPath linkTarget a -> m
foldMap :: forall m a.
Monoid m =>
(a -> m) -> GenEntries tarPath linkTarget a -> m
$cfoldMap' :: forall tarPath linkTarget m a.
Monoid m =>
(a -> m) -> GenEntries tarPath linkTarget a -> m
foldMap' :: forall m a.
Monoid m =>
(a -> m) -> GenEntries tarPath linkTarget a -> m
$cfoldr :: forall tarPath linkTarget a b.
(a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b
foldr :: forall a b.
(a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b
$cfoldr' :: forall tarPath linkTarget a b.
(a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b
foldr' :: forall a b.
(a -> b -> b) -> b -> GenEntries tarPath linkTarget a -> b
$cfoldl :: forall tarPath linkTarget b a.
(b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b
foldl :: forall b a.
(b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b
$cfoldl' :: forall tarPath linkTarget b a.
(b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b
foldl' :: forall b a.
(b -> a -> b) -> b -> GenEntries tarPath linkTarget a -> b
$cfoldr1 :: forall tarPath linkTarget a.
(a -> a -> a) -> GenEntries tarPath linkTarget a -> a
foldr1 :: forall a. (a -> a -> a) -> GenEntries tarPath linkTarget a -> a
$cfoldl1 :: forall tarPath linkTarget a.
(a -> a -> a) -> GenEntries tarPath linkTarget a -> a
foldl1 :: forall a. (a -> a -> a) -> GenEntries tarPath linkTarget a -> a
$ctoList :: forall tarPath linkTarget a. GenEntries tarPath linkTarget a -> [a]
toList :: forall a. GenEntries tarPath linkTarget a -> [a]
$cnull :: forall tarPath linkTarget a.
GenEntries tarPath linkTarget a -> Bool
null :: forall a. GenEntries tarPath linkTarget a -> Bool
$clength :: forall tarPath linkTarget a. GenEntries tarPath linkTarget a -> Int
length :: forall a. GenEntries tarPath linkTarget a -> Int
$celem :: forall tarPath linkTarget a.
Eq a =>
a -> GenEntries tarPath linkTarget a -> Bool
elem :: forall a. Eq a => a -> GenEntries tarPath linkTarget a -> Bool
$cmaximum :: forall tarPath linkTarget a.
Ord a =>
GenEntries tarPath linkTarget a -> a
maximum :: forall a. Ord a => GenEntries tarPath linkTarget a -> a
$cminimum :: forall tarPath linkTarget a.
Ord a =>
GenEntries tarPath linkTarget a -> a
minimum :: forall a. Ord a => GenEntries tarPath linkTarget a -> a
$csum :: forall tarPath linkTarget a.
Num a =>
GenEntries tarPath linkTarget a -> a
sum :: forall a. Num a => GenEntries tarPath linkTarget a -> a
$cproduct :: forall tarPath linkTarget a.
Num a =>
GenEntries tarPath linkTarget a -> a
product :: forall a. Num a => GenEntries tarPath linkTarget a -> a
Foldable    -- ^ @since 0.6.0.0
    , Functor (GenEntries tarPath linkTarget)
Foldable (GenEntries tarPath linkTarget)
(Functor (GenEntries tarPath linkTarget),
 Foldable (GenEntries tarPath linkTarget)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b)
 -> GenEntries tarPath linkTarget a
 -> f (GenEntries tarPath linkTarget b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GenEntries tarPath linkTarget (f a)
    -> f (GenEntries tarPath linkTarget a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b)
    -> GenEntries tarPath linkTarget a
    -> m (GenEntries tarPath linkTarget b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GenEntries tarPath linkTarget (m a)
    -> m (GenEntries tarPath linkTarget a))
-> Traversable (GenEntries tarPath linkTarget)
forall tarPath linkTarget. Functor (GenEntries tarPath linkTarget)
forall tarPath linkTarget. Foldable (GenEntries tarPath linkTarget)
forall tarPath linkTarget (m :: * -> *) a.
Monad m =>
GenEntries tarPath linkTarget (m a)
-> m (GenEntries tarPath linkTarget a)
forall tarPath linkTarget (f :: * -> *) a.
Applicative f =>
GenEntries tarPath linkTarget (f a)
-> f (GenEntries tarPath linkTarget a)
forall tarPath linkTarget (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> GenEntries tarPath linkTarget a
-> m (GenEntries tarPath linkTarget b)
forall tarPath linkTarget (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenEntries tarPath linkTarget a
-> f (GenEntries tarPath linkTarget b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
GenEntries tarPath linkTarget (m a)
-> m (GenEntries tarPath linkTarget a)
forall (f :: * -> *) a.
Applicative f =>
GenEntries tarPath linkTarget (f a)
-> f (GenEntries tarPath linkTarget a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> GenEntries tarPath linkTarget a
-> m (GenEntries tarPath linkTarget b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenEntries tarPath linkTarget a
-> f (GenEntries tarPath linkTarget b)
$ctraverse :: forall tarPath linkTarget (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenEntries tarPath linkTarget a
-> f (GenEntries tarPath linkTarget b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenEntries tarPath linkTarget a
-> f (GenEntries tarPath linkTarget b)
$csequenceA :: forall tarPath linkTarget (f :: * -> *) a.
Applicative f =>
GenEntries tarPath linkTarget (f a)
-> f (GenEntries tarPath linkTarget a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GenEntries tarPath linkTarget (f a)
-> f (GenEntries tarPath linkTarget a)
$cmapM :: forall tarPath linkTarget (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> GenEntries tarPath linkTarget a
-> m (GenEntries tarPath linkTarget b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> GenEntries tarPath linkTarget a
-> m (GenEntries tarPath linkTarget b)
$csequence :: forall tarPath linkTarget (m :: * -> *) a.
Monad m =>
GenEntries tarPath linkTarget (m a)
-> m (GenEntries tarPath linkTarget a)
sequence :: forall (m :: * -> *) a.
Monad m =>
GenEntries tarPath linkTarget (m a)
-> m (GenEntries tarPath linkTarget a)
Traversable -- ^ @since 0.6.0.0
    )

infixr 5 `Next`

-- | Monomorphic sequence of archive entries,
-- ready for serialization / deserialization.
type Entries e = GenEntries TarPath LinkTarget e

-- | This is like the standard 'Data.List.unfoldr' function on lists, but for 'Entries'.
-- It includes failure as an extra possibility that the stepper function may
-- return.
--
-- It can be used to generate 'Entries' from some other type. For example it is
-- used internally to lazily unfold entries from a 'LBS.ByteString'.
--
unfoldEntries
  :: (a -> Either e (Maybe (GenEntry tarPath linkTarget, a)))
  -> a
  -> GenEntries tarPath linkTarget e
unfoldEntries :: forall a e tarPath linkTarget.
(a -> Either e (Maybe (GenEntry tarPath linkTarget, a)))
-> a -> GenEntries tarPath linkTarget e
unfoldEntries a -> Either e (Maybe (GenEntry tarPath linkTarget, a))
f = a -> GenEntries tarPath linkTarget e
unfold
  where
    unfold :: a -> GenEntries tarPath linkTarget e
unfold a
x = case a -> Either e (Maybe (GenEntry tarPath linkTarget, a))
f a
x of
      Left e
err             -> e -> GenEntries tarPath linkTarget e
forall tarPath linkTarget e. e -> GenEntries tarPath linkTarget e
Fail e
err
      Right Maybe (GenEntry tarPath linkTarget, a)
Nothing        -> GenEntries tarPath linkTarget e
forall tarPath linkTarget e. GenEntries tarPath linkTarget e
Done
      Right (Just (GenEntry tarPath linkTarget
e, a
x')) -> GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
forall tarPath linkTarget e.
GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
Next GenEntry tarPath linkTarget
e (a -> GenEntries tarPath linkTarget e
unfold a
x')

unfoldEntriesM
  :: Monad m
  => (forall a. m a -> m a)
  -- ^ id or unsafeInterleaveIO
  -> m (Either e (Maybe (GenEntry tarPath linkTarget)))
  -> m (GenEntries tarPath linkTarget e)
unfoldEntriesM :: forall (m :: * -> *) e tarPath linkTarget.
Monad m =>
(forall a. m a -> m a)
-> m (Either e (Maybe (GenEntry tarPath linkTarget)))
-> m (GenEntries tarPath linkTarget e)
unfoldEntriesM forall a. m a -> m a
interleave m (Either e (Maybe (GenEntry tarPath linkTarget)))
f = m (GenEntries tarPath linkTarget e)
unfold
  where
    unfold :: m (GenEntries tarPath linkTarget e)
unfold = do
      Either e (Maybe (GenEntry tarPath linkTarget))
f' <- m (Either e (Maybe (GenEntry tarPath linkTarget)))
f
      case Either e (Maybe (GenEntry tarPath linkTarget))
f' of
        Left e
err       -> GenEntries tarPath linkTarget e
-> m (GenEntries tarPath linkTarget e)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenEntries tarPath linkTarget e
 -> m (GenEntries tarPath linkTarget e))
-> GenEntries tarPath linkTarget e
-> m (GenEntries tarPath linkTarget e)
forall a b. (a -> b) -> a -> b
$ e -> GenEntries tarPath linkTarget e
forall tarPath linkTarget e. e -> GenEntries tarPath linkTarget e
Fail e
err
        Right Maybe (GenEntry tarPath linkTarget)
Nothing  -> GenEntries tarPath linkTarget e
-> m (GenEntries tarPath linkTarget e)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenEntries tarPath linkTarget e
forall tarPath linkTarget e. GenEntries tarPath linkTarget e
Done
        Right (Just GenEntry tarPath linkTarget
e) -> GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
forall tarPath linkTarget e.
GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
Next GenEntry tarPath linkTarget
e (GenEntries tarPath linkTarget e
 -> GenEntries tarPath linkTarget e)
-> m (GenEntries tarPath linkTarget e)
-> m (GenEntries tarPath linkTarget e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (GenEntries tarPath linkTarget e)
-> m (GenEntries tarPath linkTarget e)
forall a. m a -> m a
interleave m (GenEntries tarPath linkTarget e)
unfold

-- | This is like the standard 'Data.List.foldr' function on lists, but for 'Entries'.
-- Compared to 'Data.List.foldr' it takes an extra function to account for the
-- possibility of failure.
--
-- This is used to consume a sequence of entries. For example it could be used
-- to scan a tarball for problems or to collect an index of the contents.
--
foldEntries
  :: (GenEntry tarPath linkTarget -> a -> a)
  -> a
  -> (e -> a)
  -> GenEntries tarPath linkTarget e -> a
foldEntries :: forall tarPath linkTarget a e.
(GenEntry tarPath linkTarget -> a -> a)
-> a -> (e -> a) -> GenEntries tarPath linkTarget e -> a
foldEntries GenEntry tarPath linkTarget -> a -> a
next a
done e -> a
fail' = GenEntries tarPath linkTarget e -> a
fold
  where
    fold :: GenEntries tarPath linkTarget e -> a
fold (Next GenEntry tarPath linkTarget
e GenEntries tarPath linkTarget e
es) = GenEntry tarPath linkTarget -> a -> a
next GenEntry tarPath linkTarget
e (GenEntries tarPath linkTarget e -> a
fold GenEntries tarPath linkTarget e
es)
    fold GenEntries tarPath linkTarget e
Done        = a
done
    fold (Fail e
err)  = e -> a
fail' e
err

-- | A 'Data.List.foldl'-like function on Entries. It either returns the final
-- accumulator result, or the failure along with the intermediate accumulator
-- value.
--
foldlEntries
  :: (a -> GenEntry tarPath linkTarget -> a)
  -> a
  -> GenEntries tarPath linkTarget e
  -> Either (e, a) a
foldlEntries :: forall a tarPath linkTarget e.
(a -> GenEntry tarPath linkTarget -> a)
-> a -> GenEntries tarPath linkTarget e -> Either (e, a) a
foldlEntries a -> GenEntry tarPath linkTarget -> a
f = a -> GenEntries tarPath linkTarget e -> Either (e, a) a
forall {a}. a -> GenEntries tarPath linkTarget a -> Either (a, a) a
go
  where
    go :: a -> GenEntries tarPath linkTarget a -> Either (a, a) a
go !a
acc (Next GenEntry tarPath linkTarget
e GenEntries tarPath linkTarget a
es) = a -> GenEntries tarPath linkTarget a -> Either (a, a) a
go (a -> GenEntry tarPath linkTarget -> a
f a
acc GenEntry tarPath linkTarget
e) GenEntries tarPath linkTarget a
es
    go !a
acc  GenEntries tarPath linkTarget a
Done       = a -> Either (a, a) a
forall a b. b -> Either a b
Right a
acc
    go !a
acc (Fail a
err)  = (a, a) -> Either (a, a) a
forall a b. a -> Either a b
Left (a
err, a
acc)

-- | This is like the standard 'Data.List.map' function on lists, but for 'Entries'. It
-- includes failure as a extra possible outcome of the mapping function.
--
-- If your mapping function cannot fail it may be more convenient to use
-- 'mapEntriesNoFail'
mapEntries
  :: (GenEntry tarPath linkTarget -> Either e' (GenEntry tarPath linkTarget))
  -- ^ Function to apply to each entry
  -> GenEntries tarPath linkTarget e
  -- ^ Input sequence
  -> GenEntries tarPath linkTarget (Either e e')
mapEntries :: forall tarPath linkTarget e' e.
(GenEntry tarPath linkTarget
 -> Either e' (GenEntry tarPath linkTarget))
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget (Either e e')
mapEntries GenEntry tarPath linkTarget
-> Either e' (GenEntry tarPath linkTarget)
f =
  (GenEntry tarPath linkTarget
 -> GenEntries tarPath linkTarget (Either e e')
 -> GenEntries tarPath linkTarget (Either e e'))
-> GenEntries tarPath linkTarget (Either e e')
-> (e -> GenEntries tarPath linkTarget (Either e e'))
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget (Either e e')
forall tarPath linkTarget a e.
(GenEntry tarPath linkTarget -> a -> a)
-> a -> (e -> a) -> GenEntries tarPath linkTarget e -> a
foldEntries (\GenEntry tarPath linkTarget
entry GenEntries tarPath linkTarget (Either e e')
rest -> (e' -> GenEntries tarPath linkTarget (Either e e'))
-> (GenEntry tarPath linkTarget
    -> GenEntries tarPath linkTarget (Either e e'))
-> Either e' (GenEntry tarPath linkTarget)
-> GenEntries tarPath linkTarget (Either e e')
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either e e' -> GenEntries tarPath linkTarget (Either e e')
forall tarPath linkTarget e. e -> GenEntries tarPath linkTarget e
Fail (Either e e' -> GenEntries tarPath linkTarget (Either e e'))
-> (e' -> Either e e')
-> e'
-> GenEntries tarPath linkTarget (Either e e')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e' -> Either e e'
forall a b. b -> Either a b
Right) (GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget (Either e e')
-> GenEntries tarPath linkTarget (Either e e')
forall tarPath linkTarget e.
GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
`Next` GenEntries tarPath linkTarget (Either e e')
rest) (GenEntry tarPath linkTarget
-> Either e' (GenEntry tarPath linkTarget)
f GenEntry tarPath linkTarget
entry)) GenEntries tarPath linkTarget (Either e e')
forall tarPath linkTarget e. GenEntries tarPath linkTarget e
Done (Either e e' -> GenEntries tarPath linkTarget (Either e e')
forall tarPath linkTarget e. e -> GenEntries tarPath linkTarget e
Fail (Either e e' -> GenEntries tarPath linkTarget (Either e e'))
-> (e -> Either e e')
-> e
-> GenEntries tarPath linkTarget (Either e e')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e e'
forall a b. a -> Either a b
Left)

-- | Like 'mapEntries' but the mapping function itself cannot fail.
--
mapEntriesNoFail
  :: (GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget)
  -> GenEntries tarPath linkTarget e
  -> GenEntries tarPath linkTarget e
mapEntriesNoFail :: forall tarPath linkTarget e.
(GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget)
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
mapEntriesNoFail GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget
f =
  (GenEntry tarPath linkTarget
 -> GenEntries tarPath linkTarget e
 -> GenEntries tarPath linkTarget e)
-> GenEntries tarPath linkTarget e
-> (e -> GenEntries tarPath linkTarget e)
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
forall tarPath linkTarget a e.
(GenEntry tarPath linkTarget -> a -> a)
-> a -> (e -> a) -> GenEntries tarPath linkTarget e -> a
foldEntries (GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
forall tarPath linkTarget e.
GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
Next (GenEntry tarPath linkTarget
 -> GenEntries tarPath linkTarget e
 -> GenEntries tarPath linkTarget e)
-> (GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget)
-> GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenEntry tarPath linkTarget -> GenEntry tarPath linkTarget
f) GenEntries tarPath linkTarget e
forall tarPath linkTarget e. GenEntries tarPath linkTarget e
Done e -> GenEntries tarPath linkTarget e
forall tarPath linkTarget e. e -> GenEntries tarPath linkTarget e
Fail

-- | @since 0.5.1.0
instance Sem.Semigroup (GenEntries tarPath linkTarget e) where
  GenEntries tarPath linkTarget e
a <> :: GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
<> GenEntries tarPath linkTarget e
b = (GenEntry tarPath linkTarget
 -> GenEntries tarPath linkTarget e
 -> GenEntries tarPath linkTarget e)
-> GenEntries tarPath linkTarget e
-> (e -> GenEntries tarPath linkTarget e)
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
forall tarPath linkTarget a e.
(GenEntry tarPath linkTarget -> a -> a)
-> a -> (e -> a) -> GenEntries tarPath linkTarget e -> a
foldEntries GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
forall tarPath linkTarget e.
GenEntry tarPath linkTarget
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
Next GenEntries tarPath linkTarget e
b e -> GenEntries tarPath linkTarget e
forall tarPath linkTarget e. e -> GenEntries tarPath linkTarget e
Fail GenEntries tarPath linkTarget e
a

instance Monoid (GenEntries tarPath linkTarget e) where
  mempty :: GenEntries tarPath linkTarget e
mempty  = GenEntries tarPath linkTarget e
forall tarPath linkTarget e. GenEntries tarPath linkTarget e
Done
  mappend :: GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
mappend = GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
-> GenEntries tarPath linkTarget e
forall a. Semigroup a => a -> a -> a
(Sem.<>)

instance (NFData tarPath, NFData linkTarget, NFData e) => NFData (GenEntries tarPath linkTarget e) where
  rnf :: GenEntries tarPath linkTarget e -> ()
rnf (Next GenEntry tarPath linkTarget
e GenEntries tarPath linkTarget e
es) = GenEntry tarPath linkTarget -> ()
forall a. NFData a => a -> ()
rnf GenEntry tarPath linkTarget
e () -> () -> ()
forall a b. a -> b -> b
`seq` GenEntries tarPath linkTarget e -> ()
forall a. NFData a => a -> ()
rnf GenEntries tarPath linkTarget e
es
  rnf  GenEntries tarPath linkTarget e
Done       = ()
  rnf (Fail e
e)    = e -> ()
forall a. NFData a => a -> ()
rnf e
e