module Codec.Archive.Pack.Common ( mkEntry ) where

import           Codec.Archive.Types
import qualified Data.ByteString          as BS
import           System.PosixCompat.Files (fileGroup, fileMode, fileOwner,
                                           getFileStatus, isDirectory,
                                           isRegularFile, isSymbolicLink,
                                           readSymbolicLink)

mkContent :: FilePath -> IO EntryContent
mkContent :: FilePath -> IO EntryContent
mkContent fp :: FilePath
fp = do
    FileStatus
status <- FilePath -> IO FileStatus
getFileStatus FilePath
fp
    let res :: (Bool, Bool, Bool)
res = (FileStatus -> Bool
isRegularFile FileStatus
status, FileStatus -> Bool
isDirectory FileStatus
status, FileStatus -> Bool
isSymbolicLink FileStatus
status)
    case (Bool, Bool, Bool)
res of
        (True, False, False) -> ByteString -> EntryContent
NormalFile (ByteString -> EntryContent) -> IO ByteString -> IO EntryContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile FilePath
fp
        (False, True, False) -> EntryContent -> IO EntryContent
forall (f :: * -> *) a. Applicative f => a -> f a
pure EntryContent
Directory
        (False, False, True) -> FilePath -> EntryContent
Symlink (FilePath -> EntryContent) -> IO FilePath -> IO EntryContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readSymbolicLink FilePath
fp
        (_, _, _)            -> FilePath -> IO EntryContent
forall a. HasCallStack => FilePath -> a
error "inconsistent read result"

mkEntry :: FilePath -> IO Entry
mkEntry :: FilePath -> IO Entry
mkEntry fp :: FilePath
fp = do
    FileStatus
status <- FilePath -> IO FileStatus
getFileStatus FilePath
fp
    EntryContent
content' <- FilePath -> IO EntryContent
mkContent FilePath
fp
    Entry -> IO Entry
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Entry -> IO Entry) -> Entry -> IO Entry
forall a b. (a -> b) -> a -> b
$ FilePath
-> EntryContent
-> Permissions
-> Ownership
-> Maybe ModTime
-> Entry
Entry FilePath
fp EntryContent
content' (FileStatus -> Permissions
fileMode FileStatus
status) (Maybe FilePath -> Maybe FilePath -> Id -> Id -> Ownership
Ownership Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing (UserID -> Id
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UserID -> Id) -> UserID -> Id
forall a b. (a -> b) -> a -> b
$ FileStatus -> UserID
fileOwner FileStatus
status) (GroupID -> Id
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GroupID -> Id) -> GroupID -> Id
forall a b. (a -> b) -> a -> b
$ FileStatus -> GroupID
fileGroup FileStatus
status)) Maybe ModTime
forall a. Maybe a
Nothing