module Codec.Archive.Types ( -- * Concrete (Haskell) data types
                             Entry (..)
                           , EntryContent (..)
                           , Ownership (..)
                           , ModTime
                           , Id
                           , Permissions
                           , ArchiveEncryption (..)
                           , ArchiveResult (..)
                           -- * Foreign types
                           , module Codec.Archive.Types.Foreign
                           -- * Callbacks
                           , ArchiveOpenCallback
                           , ArchiveCloseCallback
                           , ArchiveSwitchCallback
                           -- * Marshalling functions
                           , errorRes
                           , resultToErr
                           ) where

import           Codec.Archive.Types.Foreign
import qualified Data.ByteString             as BS
import           Data.Int                    (Int64)
import           Foreign.C.Types             (CInt, CLong, CTime)
import           Foreign.Ptr                 (Ptr)
import           System.Posix.Types          (CMode (..))

type ArchiveOpenCallback a = Ptr Archive -> Ptr a -> IO ArchiveResult
type ArchiveCloseCallback a = Ptr Archive -> Ptr a -> IO ArchiveResult
type ArchiveSwitchCallback a b = Ptr Archive -> Ptr a -> Ptr b -> IO ArchiveResult

resultToErr :: ArchiveResult -> CInt
resultToErr :: ArchiveResult -> CInt
resultToErr = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (ArchiveResult -> Int) -> ArchiveResult -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveResult -> Int
forall a. Enum a => a -> Int
fromEnum

errorRes :: Integral a => a -> ArchiveResult
errorRes :: a -> ArchiveResult
errorRes = Int -> ArchiveResult
forall a. Enum a => Int -> a
toEnum (Int -> ArchiveResult) -> (a -> Int) -> a -> ArchiveResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

data ArchiveEncryption = HasEncryption
                       | NoEncryption
                       | EncryptionUnsupported
                       | EncryptionUnknown

-- TODO: support everything here: http://hackage.haskell.org/package/tar/docs/Codec-Archive-Tar-Entry.html#t:EntryContent
data EntryContent = NormalFile !BS.ByteString
                  | Directory
                  | Symlink !FilePath
                  | Hardlink !FilePath

data Entry = Entry { Entry -> FilePath
filepath    :: !FilePath
                   , Entry -> EntryContent
content     :: !EntryContent
                   , Entry -> Permissions
permissions :: !Permissions
                   , Entry -> Ownership
ownership   :: !Ownership
                   , Entry -> Maybe ModTime
time        :: !(Maybe ModTime)
                   }

data Ownership = Ownership { Ownership -> Maybe FilePath
userName  :: !(Maybe String)
                           , Ownership -> Maybe FilePath
groupName :: !(Maybe String)
                           , Ownership -> Id
ownerId   :: !Id
                           , Ownership -> Id
groupId   :: !Id
                           }

type Permissions = CMode
type ModTime = (CTime, CLong)

-- | A user or group ID
type Id = Int64