{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, BangPatterns #-}
module Codec.Archive.Tar.Types (
Entry(..),
entryPath,
EntryContent(..),
FileSize,
Permissions,
Ownership(..),
EpochTime,
TypeCode,
DevMajor,
DevMinor,
Format(..),
simpleEntry,
fileEntry,
directoryEntry,
ordinaryFilePermissions,
executableFilePermissions,
directoryPermissions,
TarPath(..),
toTarPath,
fromTarPath,
fromTarPathToPosixPath,
fromTarPathToWindowsPath,
LinkTarget(..),
toLinkTarget,
fromLinkTarget,
fromLinkTargetToPosixPath,
fromLinkTargetToWindowsPath,
Entries(..),
mapEntries,
mapEntriesNoFail,
foldEntries,
foldlEntries,
unfoldEntries,
#ifdef TESTS
limitToV7FormatCompat
#endif
) where
import Data.Int (Int64)
import Data.Monoid (Monoid(..))
import Data.Semigroup as Sem
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 qualified System.FilePath as FilePath.Native
( joinPath, splitDirectories, addTrailingPathSeparator )
import qualified System.FilePath.Posix as FilePath.Posix
( joinPath, splitPath, splitDirectories, hasTrailingPathSeparator
, addTrailingPathSeparator )
import qualified System.FilePath.Windows as FilePath.Windows
( joinPath, addTrailingPathSeparator )
import System.Posix.Types
( FileMode )
#ifdef TESTS
import Test.QuickCheck
import Control.Applicative ((<$>), (<*>), pure)
import Data.Word (Word16)
#endif
type FileSize = Int64
type EpochTime = Int64
type DevMajor = Int
type DevMinor = Int
type TypeCode = Char
type Permissions = FileMode
data Entry = Entry {
Entry -> TarPath
entryTarPath :: {-# UNPACK #-} !TarPath,
Entry -> EntryContent
entryContent :: !EntryContent,
Entry -> Permissions
entryPermissions :: {-# UNPACK #-} !Permissions,
Entry -> Ownership
entryOwnership :: {-# UNPACK #-} !Ownership,
Entry -> EpochTime
entryTime :: {-# UNPACK #-} !EpochTime,
Entry -> Format
entryFormat :: !Format
}
deriving (Entry -> Entry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c== :: Entry -> Entry -> Bool
Eq, Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> String
$cshow :: Entry -> String
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show)
entryPath :: Entry -> FilePath
entryPath :: Entry -> String
entryPath = TarPath -> String
fromTarPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> TarPath
entryTarPath
data EntryContent = 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 (EntryContent -> EntryContent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntryContent -> EntryContent -> Bool
$c/= :: EntryContent -> EntryContent -> Bool
== :: EntryContent -> EntryContent -> Bool
$c== :: EntryContent -> EntryContent -> Bool
Eq, Eq EntryContent
EntryContent -> EntryContent -> Bool
EntryContent -> EntryContent -> Ordering
EntryContent -> EntryContent -> EntryContent
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
min :: EntryContent -> EntryContent -> EntryContent
$cmin :: EntryContent -> EntryContent -> EntryContent
max :: EntryContent -> EntryContent -> EntryContent
$cmax :: EntryContent -> EntryContent -> EntryContent
>= :: EntryContent -> EntryContent -> Bool
$c>= :: EntryContent -> EntryContent -> Bool
> :: EntryContent -> EntryContent -> Bool
$c> :: EntryContent -> EntryContent -> Bool
<= :: EntryContent -> EntryContent -> Bool
$c<= :: EntryContent -> EntryContent -> Bool
< :: EntryContent -> EntryContent -> Bool
$c< :: EntryContent -> EntryContent -> Bool
compare :: EntryContent -> EntryContent -> Ordering
$ccompare :: EntryContent -> EntryContent -> Ordering
Ord, Int -> EntryContent -> ShowS
[EntryContent] -> ShowS
EntryContent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntryContent] -> ShowS
$cshowList :: [EntryContent] -> ShowS
show :: EntryContent -> String
$cshow :: EntryContent -> String
showsPrec :: Int -> EntryContent -> ShowS
$cshowsPrec :: Int -> EntryContent -> ShowS
Show)
data Ownership = Ownership {
Ownership -> String
ownerName :: String,
Ownership -> String
groupName :: String,
Ownership -> Int
ownerId :: {-# UNPACK #-} !Int,
Ownership -> Int
groupId :: {-# UNPACK #-} !Int
}
deriving (Ownership -> Ownership -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ownership -> Ownership -> Bool
$c/= :: Ownership -> Ownership -> Bool
== :: Ownership -> Ownership -> Bool
$c== :: Ownership -> Ownership -> Bool
Eq, Eq 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
min :: Ownership -> Ownership -> Ownership
$cmin :: Ownership -> Ownership -> Ownership
max :: Ownership -> Ownership -> Ownership
$cmax :: Ownership -> Ownership -> Ownership
>= :: Ownership -> Ownership -> Bool
$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
compare :: Ownership -> Ownership -> Ordering
$ccompare :: Ownership -> Ownership -> Ordering
Ord, Int -> Ownership -> ShowS
[Ownership] -> ShowS
Ownership -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ownership] -> ShowS
$cshowList :: [Ownership] -> ShowS
show :: Ownership -> String
$cshow :: Ownership -> String
showsPrec :: Int -> Ownership -> ShowS
$cshowsPrec :: Int -> Ownership -> ShowS
Show)
data Format =
V7Format
| UstarFormat
| GnuFormat
deriving (Format -> Format -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, Eq 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
min :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmax :: Format -> Format -> Format
>= :: Format -> Format -> Bool
$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
compare :: Format -> Format -> Ordering
$ccompare :: Format -> Format -> Ordering
Ord, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show)
instance NFData Entry where
rnf :: Entry -> ()
rnf (Entry TarPath
_ EntryContent
c Permissions
_ Ownership
_ EpochTime
_ Format
_) = forall a. NFData a => a -> ()
rnf EntryContent
c
instance NFData EntryContent where
rnf :: EntryContent -> ()
rnf EntryContent
x = case EntryContent
x of
NormalFile ByteString
c EpochTime
_ -> ByteString -> ()
rnflbs ByteString
c
OtherEntryType TypeCode
_ ByteString
c EpochTime
_ -> ByteString -> ()
rnflbs ByteString
c
EntryContent
_ -> seq :: forall a b. a -> b -> b
seq EntryContent
x ()
where
#if MIN_VERSION_bytestring(0,10,0)
rnflbs :: ByteString -> ()
rnflbs = forall a. NFData a => a -> ()
rnf
#else
rnflbs = foldr (\ !_bs r -> r) () . LBS.toChunks
#endif
instance NFData Ownership where
rnf :: Ownership -> ()
rnf (Ownership String
o String
g Int
_ Int
_) = forall a. NFData a => a -> ()
rnf String
o seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf String
g
ordinaryFilePermissions :: Permissions
ordinaryFilePermissions :: Permissions
ordinaryFilePermissions = Permissions
0o0644
executableFilePermissions :: Permissions
executableFilePermissions :: Permissions
executableFilePermissions = Permissions
0o0755
directoryPermissions :: Permissions
directoryPermissions :: Permissions
directoryPermissions = Permissions
0o0755
simpleEntry :: TarPath -> EntryContent -> Entry
simpleEntry :: TarPath -> EntryContent -> Entry
simpleEntry TarPath
tarpath EntryContent
content = Entry {
entryTarPath :: TarPath
entryTarPath = TarPath
tarpath,
entryContent :: EntryContent
entryContent = EntryContent
content,
entryPermissions :: Permissions
entryPermissions = case EntryContent
content of
EntryContent
Directory -> Permissions
directoryPermissions
EntryContent
_ -> 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
}
fileEntry :: TarPath -> LBS.ByteString -> Entry
fileEntry :: TarPath -> ByteString -> Entry
fileEntry TarPath
name ByteString
fileContent =
TarPath -> EntryContent -> Entry
simpleEntry TarPath
name (ByteString -> EpochTime -> EntryContent
NormalFile ByteString
fileContent (ByteString -> EpochTime
LBS.length ByteString
fileContent))
directoryEntry :: TarPath -> Entry
directoryEntry :: TarPath -> Entry
directoryEntry TarPath
name = TarPath -> EntryContent -> Entry
simpleEntry TarPath
name EntryContent
Directory
data TarPath = TarPath {-# UNPACK #-} !BS.ByteString
{-# UNPACK #-} !BS.ByteString
deriving (TarPath -> TarPath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TarPath -> TarPath -> Bool
$c/= :: TarPath -> TarPath -> Bool
== :: TarPath -> TarPath -> Bool
$c== :: TarPath -> TarPath -> Bool
Eq, Eq 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
min :: TarPath -> TarPath -> TarPath
$cmin :: TarPath -> TarPath -> TarPath
max :: TarPath -> TarPath -> TarPath
$cmax :: TarPath -> TarPath -> TarPath
>= :: TarPath -> TarPath -> Bool
$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
compare :: TarPath -> TarPath -> Ordering
$ccompare :: TarPath -> TarPath -> Ordering
Ord)
instance NFData TarPath where
rnf :: TarPath -> ()
rnf (TarPath ByteString
_ ByteString
_) = ()
instance Show TarPath where
show :: TarPath -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. TarPath -> String
fromTarPath
fromTarPath :: TarPath -> FilePath
fromTarPath :: TarPath -> String
fromTarPath (TarPath ByteString
namebs ByteString
prefixbs) = ShowS
adjustDirectory forall a b. (a -> b) -> a -> b
$
[String] -> String
FilePath.Native.joinPath forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Posix.splitDirectories String
prefix
forall a. [a] -> [a] -> [a]
++ String -> [String]
FilePath.Posix.splitDirectories String
name
where
name :: String
name = ByteString -> String
BS.Char8.unpack ByteString
namebs
prefix :: String
prefix = ByteString -> String
BS.Char8.unpack ByteString
prefixbs
adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Posix.hasTrailingPathSeparator String
name
= ShowS
FilePath.Native.addTrailingPathSeparator
| Bool
otherwise = forall a. a -> a
id
fromTarPathToPosixPath :: TarPath -> FilePath
fromTarPathToPosixPath :: TarPath -> String
fromTarPathToPosixPath (TarPath ByteString
namebs ByteString
prefixbs) = ShowS
adjustDirectory forall a b. (a -> b) -> a -> b
$
[String] -> String
FilePath.Posix.joinPath forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Posix.splitDirectories String
prefix
forall a. [a] -> [a] -> [a]
++ String -> [String]
FilePath.Posix.splitDirectories String
name
where
name :: String
name = ByteString -> String
BS.Char8.unpack ByteString
namebs
prefix :: String
prefix = ByteString -> String
BS.Char8.unpack ByteString
prefixbs
adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Posix.hasTrailingPathSeparator String
name
= ShowS
FilePath.Posix.addTrailingPathSeparator
| Bool
otherwise = forall a. a -> a
id
fromTarPathToWindowsPath :: TarPath -> FilePath
fromTarPathToWindowsPath :: TarPath -> String
fromTarPathToWindowsPath (TarPath ByteString
namebs ByteString
prefixbs) = ShowS
adjustDirectory forall a b. (a -> b) -> a -> b
$
[String] -> String
FilePath.Windows.joinPath forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Posix.splitDirectories String
prefix
forall a. [a] -> [a] -> [a]
++ String -> [String]
FilePath.Posix.splitDirectories String
name
where
name :: String
name = ByteString -> String
BS.Char8.unpack ByteString
namebs
prefix :: String
prefix = ByteString -> String
BS.Char8.unpack ByteString
prefixbs
adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Posix.hasTrailingPathSeparator String
name
= ShowS
FilePath.Windows.addTrailingPathSeparator
| Bool
otherwise = forall a. a -> a
id
toTarPath :: Bool
-> FilePath -> Either String TarPath
toTarPath :: Bool -> String -> Either String TarPath
toTarPath Bool
isDir = String -> Either String TarPath
splitLongPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
addTrailingSep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
FilePath.Posix.joinPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
FilePath.Native.splitDirectories
where
addTrailingSep :: ShowS
addTrailingSep | Bool
isDir = ShowS
FilePath.Posix.addTrailingPathSeparator
| Bool
otherwise = forall a. a -> a
id
splitLongPath :: FilePath -> Either String TarPath
splitLongPath :: String -> Either String TarPath
splitLongPath String
path =
case Int -> [String] -> Either String (String, [String])
packName Int
nameMax (forall a. [a] -> [a]
reverse (String -> [String]
FilePath.Posix.splitPath String
path)) of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right (String
name, []) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> TarPath
TarPath (String -> ByteString
BS.Char8.pack String
name)
ByteString
BS.empty
Right (String
name, String
first:[String]
rest) -> case Int -> [String] -> Either String (String, [String])
packName Int
prefixMax [String]
remainder of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right (String
_ , (String
_:[String]
_)) -> forall a b. a -> Either a b
Left String
"File name too long (cannot split)"
Right (String
prefix, []) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> TarPath
TarPath (String -> ByteString
BS.Char8.pack String
name)
(String -> ByteString
BS.Char8.pack String
prefix)
where
remainder :: [String]
remainder = forall a. [a] -> [a]
init String
first forall a. a -> [a] -> [a]
: [String]
rest
where
nameMax, prefixMax :: Int
nameMax :: Int
nameMax = Int
100
prefixMax :: Int
prefixMax = Int
155
packName :: Int -> [String] -> Either String (String, [String])
packName Int
_ [] = forall a b. a -> Either a b
Left String
"File name empty"
packName Int
maxLen (String
c:[String]
cs)
| Int
n forall a. Ord a => a -> a -> Bool
> Int
maxLen = forall a b. a -> Either a b
Left String
"File name too long"
| Bool
otherwise = forall a b. b -> Either a b
Right (Int -> Int -> [String] -> [String] -> (String, [String])
packName' Int
maxLen Int
n [String
c] [String]
cs)
where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c
packName' :: Int -> Int -> [String] -> [String] -> (String, [String])
packName' Int
maxLen Int
n [String]
ok (String
c:[String]
cs)
| Int
n' forall a. Ord a => a -> a -> Bool
<= Int
maxLen = Int -> Int -> [String] -> [String] -> (String, [String])
packName' Int
maxLen Int
n' (String
cforall a. a -> [a] -> [a]
:[String]
ok) [String]
cs
where n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
+ 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)
newtype LinkTarget = LinkTarget BS.ByteString
deriving (LinkTarget -> LinkTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkTarget -> LinkTarget -> Bool
$c/= :: LinkTarget -> LinkTarget -> Bool
== :: LinkTarget -> LinkTarget -> Bool
$c== :: LinkTarget -> LinkTarget -> Bool
Eq, Eq 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
min :: LinkTarget -> LinkTarget -> LinkTarget
$cmin :: LinkTarget -> LinkTarget -> LinkTarget
max :: LinkTarget -> LinkTarget -> LinkTarget
$cmax :: LinkTarget -> LinkTarget -> LinkTarget
>= :: LinkTarget -> LinkTarget -> Bool
$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
compare :: LinkTarget -> LinkTarget -> Ordering
$ccompare :: LinkTarget -> LinkTarget -> Ordering
Ord, Int -> LinkTarget -> ShowS
[LinkTarget] -> ShowS
LinkTarget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkTarget] -> ShowS
$cshowList :: [LinkTarget] -> ShowS
show :: LinkTarget -> String
$cshow :: LinkTarget -> String
showsPrec :: Int -> LinkTarget -> ShowS
$cshowsPrec :: Int -> LinkTarget -> ShowS
Show)
instance NFData LinkTarget where
#if MIN_VERSION_bytestring(0,10,0)
rnf :: LinkTarget -> ()
rnf (LinkTarget ByteString
bs) = forall a. NFData a => a -> ()
rnf ByteString
bs
#else
rnf (LinkTarget !_bs) = ()
#endif
toLinkTarget :: FilePath -> Maybe LinkTarget
toLinkTarget :: String -> Maybe LinkTarget
toLinkTarget String
path | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
path forall a. Ord a => a -> a -> Bool
<= Int
100 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ByteString -> LinkTarget
LinkTarget (String -> ByteString
BS.Char8.pack String
path)
| Bool
otherwise = forall a. Maybe a
Nothing
fromLinkTarget :: LinkTarget -> FilePath
fromLinkTarget :: LinkTarget -> String
fromLinkTarget (LinkTarget ByteString
pathbs) = ShowS
adjustDirectory forall a b. (a -> b) -> a -> b
$
[String] -> String
FilePath.Native.joinPath forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Posix.splitDirectories String
path
where
path :: String
path = ByteString -> String
BS.Char8.unpack ByteString
pathbs
adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Posix.hasTrailingPathSeparator String
path
= ShowS
FilePath.Native.addTrailingPathSeparator
| Bool
otherwise = forall a. a -> a
id
fromLinkTargetToPosixPath :: LinkTarget -> FilePath
fromLinkTargetToPosixPath :: LinkTarget -> String
fromLinkTargetToPosixPath (LinkTarget ByteString
pathbs) = ShowS
adjustDirectory forall a b. (a -> b) -> a -> b
$
[String] -> String
FilePath.Posix.joinPath forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Posix.splitDirectories String
path
where
path :: String
path = ByteString -> String
BS.Char8.unpack ByteString
pathbs
adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Posix.hasTrailingPathSeparator String
path
= ShowS
FilePath.Native.addTrailingPathSeparator
| Bool
otherwise = forall a. a -> a
id
fromLinkTargetToWindowsPath :: LinkTarget -> FilePath
fromLinkTargetToWindowsPath :: LinkTarget -> String
fromLinkTargetToWindowsPath (LinkTarget ByteString
pathbs) = ShowS
adjustDirectory forall a b. (a -> b) -> a -> b
$
[String] -> String
FilePath.Windows.joinPath forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Posix.splitDirectories String
path
where
path :: String
path = ByteString -> String
BS.Char8.unpack ByteString
pathbs
adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Posix.hasTrailingPathSeparator String
path
= ShowS
FilePath.Windows.addTrailingPathSeparator
| Bool
otherwise = forall a. a -> a
id
data Entries e = Next Entry (Entries e)
| Done
| Fail e
deriving (Entries e -> Entries e -> Bool
forall e. Eq e => Entries e -> Entries e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entries e -> Entries e -> Bool
$c/= :: forall e. Eq e => Entries e -> Entries e -> Bool
== :: Entries e -> Entries e -> Bool
$c== :: forall e. Eq e => Entries e -> Entries e -> Bool
Eq, Int -> Entries e -> ShowS
forall e. Show e => Int -> Entries e -> ShowS
forall e. Show e => [Entries e] -> ShowS
forall e. Show e => Entries e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entries e] -> ShowS
$cshowList :: forall e. Show e => [Entries e] -> ShowS
show :: Entries e -> String
$cshow :: forall e. Show e => Entries e -> String
showsPrec :: Int -> Entries e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> Entries e -> ShowS
Show)
infixr 5 `Next`
unfoldEntries :: (a -> Either e (Maybe (Entry, a))) -> a -> Entries e
unfoldEntries :: forall a e. (a -> Either e (Maybe (Entry, a))) -> a -> Entries e
unfoldEntries a -> Either e (Maybe (Entry, a))
f = a -> Entries e
unfold
where
unfold :: a -> Entries e
unfold a
x = case a -> Either e (Maybe (Entry, a))
f a
x of
Left e
err -> forall e. e -> Entries e
Fail e
err
Right Maybe (Entry, a)
Nothing -> forall e. Entries e
Done
Right (Just (Entry
e, a
x')) -> forall e. Entry -> Entries e -> Entries e
Next Entry
e (a -> Entries e
unfold a
x')
foldEntries :: (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
foldEntries :: forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
foldEntries Entry -> a -> a
next a
done e -> a
fail' = Entries e -> a
fold
where
fold :: Entries e -> a
fold (Next Entry
e Entries e
es) = Entry -> a -> a
next Entry
e (Entries e -> a
fold Entries e
es)
fold Entries e
Done = a
done
fold (Fail e
err) = e -> a
fail' e
err
foldlEntries :: (a -> Entry -> a) -> a -> Entries e -> Either (e, a) a
foldlEntries :: forall a e. (a -> Entry -> a) -> a -> Entries e -> Either (e, a) a
foldlEntries a -> Entry -> a
f a
z = forall {a}. a -> Entries a -> Either (a, a) a
go a
z
where
go :: a -> Entries a -> Either (a, a) a
go !a
acc (Next Entry
e Entries a
es) = a -> Entries a -> Either (a, a) a
go (a -> Entry -> a
f a
acc Entry
e) Entries a
es
go !a
acc Entries a
Done = forall a b. b -> Either a b
Right a
acc
go !a
acc (Fail a
err) = forall a b. a -> Either a b
Left (a
err, a
acc)
mapEntries :: (Entry -> Either e' Entry) -> Entries e -> Entries (Either e e')
mapEntries :: forall e' e.
(Entry -> Either e' Entry) -> Entries e -> Entries (Either e e')
mapEntries Entry -> Either e' Entry
f =
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
foldEntries (\Entry
entry Entries (Either e e')
rest -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e. e -> Entries e
Fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e. Entry -> Entries e -> Entries e
Next Entries (Either e e')
rest) (Entry -> Either e' Entry
f Entry
entry)) forall e. Entries e
Done (forall e. e -> Entries e
Fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
mapEntriesNoFail :: (Entry -> Entry) -> Entries e -> Entries e
mapEntriesNoFail :: forall e. (Entry -> Entry) -> Entries e -> Entries e
mapEntriesNoFail Entry -> Entry
f =
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
foldEntries (\Entry
entry -> forall e. Entry -> Entries e -> Entries e
Next (Entry -> Entry
f Entry
entry)) forall e. Entries e
Done forall e. e -> Entries e
Fail
instance Sem.Semigroup (Entries e) where
Entries e
a <> :: Entries e -> Entries e -> Entries e
<> Entries e
b = forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
foldEntries forall e. Entry -> Entries e -> Entries e
Next Entries e
b forall e. e -> Entries e
Fail Entries e
a
instance Monoid (Entries e) where
mempty :: Entries e
mempty = forall e. Entries e
Done
mappend :: Entries e -> Entries e -> Entries e
mappend = forall a. Semigroup a => a -> a -> a
(Sem.<>)
instance Functor Entries where
fmap :: forall a b. (a -> b) -> Entries a -> Entries b
fmap a -> b
f = forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
foldEntries forall e. Entry -> Entries e -> Entries e
Next forall e. Entries e
Done (forall e. e -> Entries e
Fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
instance NFData e => NFData (Entries e) where
rnf :: Entries e -> ()
rnf (Next Entry
e Entries e
es) = forall a. NFData a => a -> ()
rnf Entry
e seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Entries e
es
rnf Entries e
Done = ()
rnf (Fail e
e) = forall a. NFData a => a -> ()
rnf e
e
#ifdef TESTS
instance Arbitrary Entry where
arbitrary = Entry <$> arbitrary <*> arbitrary <*> arbitraryPermissions
<*> arbitrary <*> arbitraryEpochTime <*> arbitrary
where
arbitraryPermissions :: Gen Permissions
arbitraryPermissions = fromIntegral <$> (arbitrary :: Gen Word16)
arbitraryEpochTime :: Gen EpochTime
arbitraryEpochTime = arbitraryOctal 11
shrink (Entry path content perms author time format) =
[ Entry path' content' perms author' time' format
| (path', content', author', time') <-
shrink (path, content, author, time) ]
++ [ Entry path content perms' author time format
| perms' <- shrinkIntegral perms ]
instance Arbitrary TarPath where
arbitrary = either error id
. toTarPath False
. FilePath.Posix.joinPath
<$> listOf1ToN (255 `div` 5)
(elements (map (replicate 4) "abcd"))
shrink = map (either error id . toTarPath False)
. map FilePath.Posix.joinPath
. filter (not . null)
. shrinkList shrinkNothing
. FilePath.Posix.splitPath
. fromTarPathToPosixPath
instance Arbitrary LinkTarget where
arbitrary = maybe (error "link target too large") id
. toLinkTarget
. FilePath.Native.joinPath
<$> listOf1ToN (100 `div` 5)
(elements (map (replicate 4) "abcd"))
shrink = map (maybe (error "link target too large") id . toLinkTarget)
. map FilePath.Posix.joinPath
. filter (not . null)
. shrinkList shrinkNothing
. FilePath.Posix.splitPath
. fromLinkTargetToPosixPath
listOf1ToN :: Int -> Gen a -> Gen [a]
listOf1ToN n g = sized $ \sz -> do
n <- choose (1, min n (max 1 sz))
vectorOf n g
listOf0ToN :: Int -> Gen a -> Gen [a]
listOf0ToN n g = sized $ \sz -> do
n <- choose (0, min n sz)
vectorOf n g
instance Arbitrary EntryContent where
arbitrary =
frequency
[ (16, do bs <- arbitrary;
return (NormalFile bs (LBS.length bs)))
, (2, pure Directory)
, (1, SymbolicLink <$> arbitrary)
, (1, HardLink <$> arbitrary)
, (1, CharacterDevice <$> arbitraryOctal 7 <*> arbitraryOctal 7)
, (1, BlockDevice <$> arbitraryOctal 7 <*> arbitraryOctal 7)
, (1, pure NamedPipe)
, (1, do c <- elements (['A'..'Z']++['a'..'z'])
bs <- arbitrary;
return (OtherEntryType c bs (LBS.length bs)))
]
shrink (NormalFile bs _) = [ NormalFile bs' (LBS.length bs')
| bs' <- shrink bs ]
shrink Directory = []
shrink (SymbolicLink link) = [ SymbolicLink link' | link' <- shrink link ]
shrink (HardLink link) = [ HardLink link' | link' <- shrink link ]
shrink (CharacterDevice ma mi) = [ CharacterDevice ma' mi'
| (ma', mi') <- shrink (ma, mi) ]
shrink (BlockDevice ma mi) = [ BlockDevice ma' mi'
| (ma', mi') <- shrink (ma, mi) ]
shrink NamedPipe = []
shrink (OtherEntryType c bs _) = [ OtherEntryType c bs' (LBS.length bs')
| bs' <- shrink bs ]
instance Arbitrary LBS.ByteString where
arbitrary = fmap LBS.pack arbitrary
shrink = map LBS.pack . shrink . LBS.unpack
instance Arbitrary BS.ByteString where
arbitrary = fmap BS.pack arbitrary
shrink = map BS.pack . shrink . BS.unpack
instance Arbitrary Ownership where
arbitrary = Ownership <$> name <*> name
<*> idno <*> idno
where
name = do
first <- choose ('a', 'z')
rest <- listOf0ToN 30 (oneof [choose ('a', 'z'), choose ('0', '9'), pure '-'])
return $ first : rest
idno = arbitraryOctal 7
shrink (Ownership oname gname oid gid) =
[ Ownership oname' gname' oid' gid'
| (oname', gname', oid', gid') <- shrink (oname, gname, oid, gid) ]
instance Arbitrary Format where
arbitrary = elements [V7Format, UstarFormat, GnuFormat]
arbitraryOctal n =
oneof [ pure 0
, choose (0, upperBound)
, pure upperBound
]
where
upperBound = 8^n-1
limitToV7FormatCompat :: Entry -> Entry
limitToV7FormatCompat entry@Entry { entryFormat = V7Format } =
entry {
entryContent = case entryContent entry of
CharacterDevice _ _ -> OtherEntryType '3' LBS.empty 0
BlockDevice _ _ -> OtherEntryType '4' LBS.empty 0
Directory -> OtherEntryType '5' LBS.empty 0
NamedPipe -> OtherEntryType '6' LBS.empty 0
other -> other,
entryOwnership = (entryOwnership entry) {
groupName = "",
ownerName = ""
},
entryTarPath = let TarPath name _prefix = entryTarPath entry
in TarPath name BS.empty
}
limitToV7FormatCompat entry = entry
#endif