    {-# LANGUAGE CPP #-}
    {-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}
    {- Note [The need for Ar.hs]
       ~~~~~~~~~~~~~~~~~~~~~~~~~
    Building `-staticlib` previously required the presence of libtool, and was a
    such restricted to mach-o only. As libtool on macOS and gnu libtool are very
    different, there was no simple portable way to support this.

    libtool for static archives does essentially: concatenate the input archives,
    add the input objects, and create a symbol index. Using `ar` for this task
    fails as even `ar` (bsd and gnu, llvm, ...) do not provide the same
    features across platforms (e.g. index prefixed retrieval of objects with
    the same name.)

    As archives are rather simple structurally, we can just build the archives
    with Haskell directly and use ranlib on the final result to get the symbol
    index. This should allow us to work around with the differences/availability
    of libtool across different platforms.
    -}
    module GHC.SysTools.Ar
      (ArchiveEntry(..)
      ,Archive(..)
      ,afilter

      ,parseAr

      ,loadAr
      ,loadObj
      ,writeBSDAr
      ,writeGNUAr

      ,isBSDSymdef
      ,isGNUSymdef
      )
       where

    import GHC.Prelude

    import Data.List (mapAccumL, isPrefixOf)
    import Data.Monoid ((<>))
    import Data.Binary.Get
    import Data.Binary.Put
    import Control.Monad
    import Control.Applicative
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Char8 as C
    import qualified Data.ByteString.Lazy as L
    #if !defined(mingw32_HOST_OS)
    import qualified System.Posix.Files as POSIX
    #endif
    import System.FilePath (takeFileName)

    data ArchiveEntry = ArchiveEntry
        { ArchiveEntry -> [Char]
    filename :: String       -- ^ File name.
        , ArchiveEntry -> Int
    filetime :: Int          -- ^ File modification time.
        , ArchiveEntry -> Int
    fileown  :: Int          -- ^ File owner.
        , ArchiveEntry -> Int
    filegrp  :: Int          -- ^ File group.
        , ArchiveEntry -> Int
    filemode :: Int          -- ^ File mode.
        , ArchiveEntry -> Int
    filesize :: Int          -- ^ File size.
        , ArchiveEntry -> ByteString
    filedata :: B.ByteString -- ^ File bytes.
        } deriving (ArchiveEntry -> ArchiveEntry -> Bool
    (ArchiveEntry -> ArchiveEntry -> Bool)
    -> (ArchiveEntry -> ArchiveEntry -> Bool) -> Eq ArchiveEntry
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ArchiveEntry -> ArchiveEntry -> Bool
    == :: ArchiveEntry -> ArchiveEntry -> Bool
    $c/= :: ArchiveEntry -> ArchiveEntry -> Bool
    /= :: ArchiveEntry -> ArchiveEntry -> Bool
    Eq, Int -> ArchiveEntry -> ShowS
    [ArchiveEntry] -> ShowS
    ArchiveEntry -> [Char]
    (Int -> ArchiveEntry -> ShowS)
    -> (ArchiveEntry -> [Char])
    -> ([ArchiveEntry] -> ShowS)
    -> Show ArchiveEntry
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ArchiveEntry -> ShowS
    showsPrec :: Int -> ArchiveEntry -> ShowS
    $cshow :: ArchiveEntry -> [Char]
    show :: ArchiveEntry -> [Char]
    $cshowList :: [ArchiveEntry] -> ShowS
    showList :: [ArchiveEntry] -> ShowS
    Show)

    newtype Archive = Archive [ArchiveEntry]
            deriving (Archive -> Archive -> Bool
    (Archive -> Archive -> Bool)
    -> (Archive -> Archive -> Bool) -> Eq Archive
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Archive -> Archive -> Bool
    == :: Archive -> Archive -> Bool
    $c/= :: Archive -> Archive -> Bool
    /= :: Archive -> Archive -> Bool
    Eq, Int -> Archive -> ShowS
    [Archive] -> ShowS
    Archive -> [Char]
    (Int -> Archive -> ShowS)
    -> (Archive -> [Char]) -> ([Archive] -> ShowS) -> Show Archive
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Archive -> ShowS
    showsPrec :: Int -> Archive -> ShowS
    $cshow :: Archive -> [Char]
    show :: Archive -> [Char]
    $cshowList :: [Archive] -> ShowS
    showList :: [Archive] -> ShowS
    Show, NonEmpty Archive -> Archive
    Archive -> Archive -> Archive
    (Archive -> Archive -> Archive)
    -> (NonEmpty Archive -> Archive)
    -> (forall b. Integral b => b -> Archive -> Archive)
    -> Semigroup Archive
    forall b. Integral b => b -> Archive -> Archive
    forall a.
    (a -> a -> a)
    -> (NonEmpty a -> a)
    -> (forall b. Integral b => b -> a -> a)
    -> Semigroup a
    $c<> :: Archive -> Archive -> Archive
    <> :: Archive -> Archive -> Archive
    $csconcat :: NonEmpty Archive -> Archive
    sconcat :: NonEmpty Archive -> Archive
    $cstimes :: forall b. Integral b => b -> Archive -> Archive
    stimes :: forall b. Integral b => b -> Archive -> Archive
    Semigroup, Semigroup Archive
    Archive
    Semigroup Archive =>
    Archive
    -> (Archive -> Archive -> Archive)
    -> ([Archive] -> Archive)
    -> Monoid Archive
    [Archive] -> Archive
    Archive -> Archive -> Archive
    forall a.
    Semigroup a =>
    a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
    $cmempty :: Archive
    mempty :: Archive
    $cmappend :: Archive -> Archive -> Archive
    mappend :: Archive -> Archive -> Archive
    $cmconcat :: [Archive] -> Archive
    mconcat :: [Archive] -> Archive
    Monoid)

    afilter :: (ArchiveEntry -> Bool) -> Archive -> Archive
    afilter :: (ArchiveEntry -> Bool) -> Archive -> Archive
    afilter ArchiveEntry -> Bool
    f (Archive [ArchiveEntry]
    xs) = [ArchiveEntry] -> Archive
    Archive ((ArchiveEntry -> Bool) -> [ArchiveEntry] -> [ArchiveEntry]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ArchiveEntry -> Bool
    f [ArchiveEntry]
    xs)

    isBSDSymdef, isGNUSymdef :: ArchiveEntry -> Bool
    isBSDSymdef :: ArchiveEntry -> Bool
    isBSDSymdef ArchiveEntry
    a = [Char]
    "__.SYMDEF" [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` (ArchiveEntry -> [Char]
    filename ArchiveEntry
    a)
    isGNUSymdef :: ArchiveEntry -> Bool
    isGNUSymdef ArchiveEntry
    a = [Char]
    "/" [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == (ArchiveEntry -> [Char]
    filename ArchiveEntry
    a)

    -- | Archives have numeric values padded with '\x20' to the right.
    getPaddedInt :: B.ByteString -> Int
    getPaddedInt :: ByteString -> Int
    getPaddedInt = [Char] -> Int
    forall a. Read a => [Char] -> a
    read ([Char] -> Int) -> (ByteString -> [Char]) -> ByteString -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [Char]
    C.unpack (ByteString -> [Char])
    -> (ByteString -> ByteString) -> ByteString -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ByteString -> ByteString
    C.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\x20')

    putPaddedInt :: Int -> Int -> Put
    putPaddedInt :: Int -> Int -> Put
    putPaddedInt Int
    padding Int
    i = Char -> Int -> [Char] -> Put
    putPaddedString Char
    '\x20' Int
    padding (Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    i)

    putPaddedString :: Char -> Int -> String -> Put
    putPaddedString :: Char -> Int -> [Char] -> Put
    putPaddedString Char
    pad Int
    padding [Char]
    s = ByteString -> Put
    putByteString (ByteString -> Put) -> ([Char] -> ByteString) -> [Char] -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ByteString
    C.pack ([Char] -> ByteString) -> ShowS -> [Char] -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    forall a. Int -> [a] -> [a]
    take Int
    padding ([Char] -> Put) -> [Char] -> Put
    forall a b. (a -> b) -> a -> b
    $ [Char]
    s [Char] -> ShowS
    forall a. Monoid a => a -> a -> a
    `mappend` (Char -> [Char]
    forall a. a -> [a]
    repeat Char
    pad)

    getBSDArchEntries :: Get [ArchiveEntry]
    getBSDArchEntries :: Get [ArchiveEntry]
    getBSDArchEntries = do
        empty <- Get Bool
    isEmpty
        if empty then
            return []
         else do
            name    <- getByteString 16
            when ('/' `C.elem` name && C.take 3 name /= "#1/") $
              fail "Looks like GNU Archive"
            time    <- getPaddedInt <$> getByteString 12
            own     <- getPaddedInt <$> getByteString 6
            grp     <- getPaddedInt <$> getByteString 6
            mode    <- getPaddedInt <$> getByteString 8
            st_size <- getPaddedInt <$> getByteString 10
            end     <- getByteString 2
            when (end /= "\x60\x0a") $
              fail ("[BSD Archive] Invalid archive header end marker for name: " ++
                    C.unpack name)
            off1    <- liftM fromIntegral bytesRead :: Get Int
            -- BSD stores extended filenames, by writing #1/<length> into the
            -- name field, the first @length@ bytes then represent the file name
            -- thus the payload size is filesize + file name length.
            name    <- if C.unpack (C.take 3 name) == "#1/" then
                            liftM (C.unpack . C.takeWhile (/= '\0')) (getByteString $ read $ C.unpack $ C.drop 3 name)
                        else
                            return $ C.unpack $ C.takeWhile (/= ' ') name
            off2    <- liftM fromIntegral bytesRead :: Get Int
            file    <- getByteString (st_size - (off2 - off1))
            -- data sections are two byte aligned (see #15396)
            when (odd st_size) $
              void (getByteString 1)

            rest    <- getBSDArchEntries
            return $ (ArchiveEntry name time own grp mode (st_size - (off2 - off1)) file) : rest

    -- | GNU Archives feature a special '//' entry that contains the
    -- extended names. Those are referred to as /<num>, where num is the
    -- offset into the '//' entry.
    -- In addition, filenames are terminated with '/' in the archive.
    getGNUArchEntries :: Maybe ArchiveEntry -> Get [ArchiveEntry]
    getGNUArchEntries :: Maybe ArchiveEntry -> Get [ArchiveEntry]
    getGNUArchEntries Maybe ArchiveEntry
    extInfo = do
      empty <- Get Bool
    isEmpty
      if empty
        then return []
        else
        do
          name    <- getByteString 16
          time    <- getPaddedInt <$> getByteString 12
          own     <- getPaddedInt <$> getByteString 6
          grp     <- getPaddedInt <$> getByteString 6
          mode    <- getPaddedInt <$> getByteString 8
          st_size <- getPaddedInt <$> getByteString 10
          end     <- getByteString 2
          when (end /= "\x60\x0a") $
            fail ("[BSD Archive] Invalid archive header end marker for name: " ++
                  C.unpack name)
          file <- getByteString st_size
          -- data sections are two byte aligned (see #15396)
          when (odd st_size) $
            void (getByteString 1)
          name <- return . C.unpack $
            if C.unpack (C.take 1 name) == "/"
            then case C.takeWhile (/= ' ') name of
                   name :: ByteString
    name@ByteString
    "/"  -> ByteString
    name               -- symbol table
                   name :: ByteString
    name@ByteString
    "//" -> ByteString
    name               -- extended file names table
                   ByteString
    name      -> Maybe ArchiveEntry -> Int -> ByteString
    getExtName Maybe ArchiveEntry
    extInfo ([Char] -> Int
    forall a. Read a => [Char] -> a
    read ([Char] -> Int) -> (ByteString -> [Char]) -> ByteString -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [Char]
    C.unpack (ByteString -> Int) -> ByteString -> Int
    forall a b. (a -> b) -> a -> b
    $ Int -> ByteString -> ByteString
    C.drop Int
    1 ByteString
    name)
            else C.takeWhile (/= '/') name
          case name of
            [Char]
    "/"  -> Maybe ArchiveEntry -> Get [ArchiveEntry]
    getGNUArchEntries Maybe ArchiveEntry
    extInfo
            [Char]
    "//" -> Maybe ArchiveEntry -> Get [ArchiveEntry]
    getGNUArchEntries (ArchiveEntry -> Maybe ArchiveEntry
    forall a. a -> Maybe a
    Just ([Char]
    -> Int -> Int -> Int -> Int -> Int -> ByteString -> ArchiveEntry
    ArchiveEntry [Char]
    name Int
    time Int
    own Int
    grp Int
    mode Int
    st_size ByteString
    file))
            [Char]
    _    -> ([Char]
    -> Int -> Int -> Int -> Int -> Int -> ByteString -> ArchiveEntry
    ArchiveEntry [Char]
    name Int
    time Int
    own Int
    grp Int
    mode Int
    st_size ByteString
    file ArchiveEntry -> [ArchiveEntry] -> [ArchiveEntry]
    forall a. a -> [a] -> [a]
    :) ([ArchiveEntry] -> [ArchiveEntry])
    -> Get [ArchiveEntry] -> Get [ArchiveEntry]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe ArchiveEntry -> Get [ArchiveEntry]
    getGNUArchEntries Maybe ArchiveEntry
    extInfo

      where
       getExtName :: Maybe ArchiveEntry -> Int -> B.ByteString
       getExtName :: Maybe ArchiveEntry -> Int -> ByteString
    getExtName Maybe ArchiveEntry
    Nothing Int
    _ = [Char] -> ByteString
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Invalid extended filename reference."
       getExtName (Just ArchiveEntry
    info) Int
    offset = (Char -> Bool) -> ByteString -> ByteString
    C.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '/') (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ByteString -> ByteString
    C.drop Int
    offset (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ArchiveEntry -> ByteString
    filedata ArchiveEntry
    info

    -- | put an Archive Entry. This assumes that the entries
    -- have been preprocessed to account for the extended file name
    -- table section "//" e.g. for GNU Archives. Or that the names
    -- have been move into the payload for BSD Archives.
    putArchEntry :: ArchiveEntry -> PutM ()
    putArchEntry :: ArchiveEntry -> Put
    putArchEntry (ArchiveEntry [Char]
    name Int
    time Int
    own Int
    grp Int
    mode Int
    st_size ByteString
    file) = do
      Char -> Int -> [Char] -> Put
    putPaddedString Char
    ' '  Int
    16 [Char]
    name
      Int -> Int -> Put
    putPaddedInt         Int
    12 Int
    time
      Int -> Int -> Put
    putPaddedInt          Int
    6 Int
    own
      Int -> Int -> Put
    putPaddedInt          Int
    6 Int
    grp
      Int -> Int -> Put
    putPaddedInt          Int
    8 Int
    mode
      Int -> Int -> Put
    putPaddedInt         Int
    10 Int
    st_size
      ByteString -> Put
    putByteString           ByteString
    "\x60\x0a"
      ByteString -> Put
    putByteString           ByteString
    file
      Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    pad Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1) (Put -> Put) -> Put -> Put
    forall a b. (a -> b) -> a -> b
    $
        Word8 -> Put
    putWord8              Word8
    0x0a
      where
        pad :: Int
    pad         = Int
    st_size Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    2

    getArchMagic :: Get ()
    getArchMagic :: Get ()
    getArchMagic = do
      magic <- (ByteString -> [Char]) -> Get ByteString -> Get [Char]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ByteString -> [Char]
    C.unpack (Get ByteString -> Get [Char]) -> Get ByteString -> Get [Char]
    forall a b. (a -> b) -> a -> b
    $ Int -> Get ByteString
    getByteString Int
    8
      if magic /= "!<arch>\n"
        then fail $ "Invalid magic number " ++ show magic
        else return ()

    putArchMagic :: Put
    putArchMagic :: Put
    putArchMagic = ByteString -> Put
    putByteString (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ [Char] -> ByteString
    C.pack [Char]
    "!<arch>\n"

    getArch :: Get Archive
    getArch :: Get Archive
    getArch = [ArchiveEntry] -> Archive
    Archive ([ArchiveEntry] -> Archive) -> Get [ArchiveEntry] -> Get Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
      Get ()
    getArchMagic
      Get [ArchiveEntry]
    getBSDArchEntries Get [ArchiveEntry] -> Get [ArchiveEntry] -> Get [ArchiveEntry]
    forall a. Get a -> Get a -> Get a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe ArchiveEntry -> Get [ArchiveEntry]
    getGNUArchEntries Maybe ArchiveEntry
    forall a. Maybe a
    Nothing

    putBSDArch :: Archive -> PutM ()
    putBSDArch :: Archive -> Put
    putBSDArch (Archive [ArchiveEntry]
    as) = do
      Put
    putArchMagic
      (ArchiveEntry -> Put) -> [ArchiveEntry] -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ArchiveEntry -> Put
    putArchEntry ([ArchiveEntry] -> [ArchiveEntry]
    processEntries [ArchiveEntry]
    as)

      where
        padStr :: a -> Int -> [a] -> [a]
    padStr a
    pad Int
    size [a]
    str = Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take Int
    size ([a] -> [a]) -> [a] -> [a]
    forall a b. (a -> b) -> a -> b
    $ [a]
    str [a] -> [a] -> [a]
    forall a. Semigroup a => a -> a -> a
    <> a -> [a]
    forall a. a -> [a]
    repeat a
    pad
        nameSize :: t a -> Int
    nameSize t a
    name = case t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    name Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    4 of
          (Int
    n, Int
    0) -> Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    n
          (Int
    n, Int
    _) -> Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
        needExt :: t Char -> Bool
    needExt t Char
    name = t Char -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t Char
    name Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    16 Bool -> Bool -> Bool
    || Char
    ' ' Char -> t Char -> Bool
    forall a. Eq a => a -> t a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` t Char
    name
        processEntry :: ArchiveEntry -> ArchiveEntry
        processEntry :: ArchiveEntry -> ArchiveEntry
    processEntry archive :: ArchiveEntry
    archive@(ArchiveEntry [Char]
    name Int
    _ Int
    _ Int
    _ Int
    _ Int
    st_size ByteString
    _)
          | [Char] -> Bool
    forall {t :: * -> *}. Foldable t => t Char -> Bool
    needExt [Char]
    name = ArchiveEntry
    archive { filename = "#1/" <> show sz
                                   , filedata = C.pack (padStr '\0' sz name) <> filedata archive
                                   , filesize = st_size + sz }
          | Bool
    otherwise    = ArchiveEntry
    archive

          where sz :: Int
    sz = [Char] -> Int
    forall {t :: * -> *} {a}. Foldable t => t a -> Int
    nameSize [Char]
    name

        processEntries :: [ArchiveEntry] -> [ArchiveEntry]
    processEntries = (ArchiveEntry -> ArchiveEntry) -> [ArchiveEntry] -> [ArchiveEntry]
    forall a b. (a -> b) -> [a] -> [b]
    map ArchiveEntry -> ArchiveEntry
    processEntry

    putGNUArch :: Archive -> PutM ()
    putGNUArch :: Archive -> Put
    putGNUArch (Archive [ArchiveEntry]
    as) = do
      Put
    putArchMagic
      (ArchiveEntry -> Put) -> [ArchiveEntry] -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ArchiveEntry -> Put
    putArchEntry ([ArchiveEntry] -> [ArchiveEntry]
    processEntries [ArchiveEntry]
    as)

      where
        processEntry :: ArchiveEntry -> ArchiveEntry -> (ArchiveEntry, ArchiveEntry)
        processEntry :: ArchiveEntry -> ArchiveEntry -> (ArchiveEntry, ArchiveEntry)
    processEntry ArchiveEntry
    extInfo archive :: ArchiveEntry
    archive@(ArchiveEntry [Char]
    name Int
    _ Int
    _ Int
    _ Int
    _ Int
    _ ByteString
    _)
          | [Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    name Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    15 = ( ArchiveEntry
    extInfo { filesize = filesize extInfo + length name + 2
                                        ,  filedata = filedata extInfo <>  C.pack name <> "/\n" }
                               , ArchiveEntry
    archive { filename = "/" <> show (filesize extInfo) } )
          | Bool
    otherwise        = ( ArchiveEntry
    extInfo, ArchiveEntry
    archive { filename = name <> "/" } )

        processEntries :: [ArchiveEntry] -> [ArchiveEntry]
        processEntries :: [ArchiveEntry] -> [ArchiveEntry]
    processEntries =
          (ArchiveEntry -> [ArchiveEntry] -> [ArchiveEntry])
    -> (ArchiveEntry, [ArchiveEntry]) -> [ArchiveEntry]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (:) ((ArchiveEntry, [ArchiveEntry]) -> [ArchiveEntry])
    -> ([ArchiveEntry] -> (ArchiveEntry, [ArchiveEntry]))
    -> [ArchiveEntry]
    -> [ArchiveEntry]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ArchiveEntry -> ArchiveEntry -> (ArchiveEntry, ArchiveEntry))
    -> ArchiveEntry -> [ArchiveEntry] -> (ArchiveEntry, [ArchiveEntry])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL ArchiveEntry -> ArchiveEntry -> (ArchiveEntry, ArchiveEntry)
    processEntry ([Char]
    -> Int -> Int -> Int -> Int -> Int -> ByteString -> ArchiveEntry
    ArchiveEntry [Char]
    "//" Int
    0 Int
    0 Int
    0 Int
    0 Int
    0 ByteString
    forall a. Monoid a => a
    mempty)

    parseAr :: B.ByteString -> Archive
    parseAr :: ByteString -> Archive
    parseAr = Get Archive -> ByteString -> Archive
    forall a. Get a -> ByteString -> a
    runGet Get Archive
    getArch (ByteString -> Archive)
    -> (ByteString -> ByteString) -> ByteString -> Archive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> ByteString
    L.fromChunks ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    writeBSDAr, writeGNUAr :: FilePath -> Archive -> IO ()
    writeBSDAr :: [Char] -> Archive -> IO ()
    writeBSDAr [Char]
    fp = [Char] -> ByteString -> IO ()
    L.writeFile [Char]
    fp (ByteString -> IO ())
    -> (Archive -> ByteString) -> Archive -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Put -> ByteString
    runPut (Put -> ByteString) -> (Archive -> Put) -> Archive -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Archive -> Put
    putBSDArch
    writeGNUAr :: [Char] -> Archive -> IO ()
    writeGNUAr [Char]
    fp = [Char] -> ByteString -> IO ()
    L.writeFile [Char]
    fp (ByteString -> IO ())
    -> (Archive -> ByteString) -> Archive -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Put -> ByteString
    runPut (Put -> ByteString) -> (Archive -> Put) -> Archive -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Archive -> Put
    putGNUArch

    loadAr :: FilePath -> IO Archive
    loadAr :: [Char] -> IO Archive
    loadAr [Char]
    fp = ByteString -> Archive
    parseAr (ByteString -> Archive) -> IO ByteString -> IO Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> IO ByteString
    B.readFile [Char]
    fp

    loadObj :: FilePath -> IO ArchiveEntry
    loadObj :: [Char] -> IO ArchiveEntry
    loadObj [Char]
    fp = do
      payload <- [Char] -> IO ByteString
    B.readFile [Char]
    fp
      (modt, own, grp, mode) <- fileInfo fp
      return $ ArchiveEntry
        (takeFileName fp) modt own grp mode
        (B.length payload) payload

    -- | Take a filePath and return (mod time, own, grp, mode in decimal)
    fileInfo :: FilePath -> IO ( Int, Int, Int, Int) -- ^ mod time, own, grp, mode (in decimal)
    #if defined(mingw32_HOST_OS)
    -- on windows mod time, owner group and mode are zero.
    fileInfo _ = pure (0,0,0,0)
    #else
    fileInfo :: [Char] -> IO (Int, Int, Int, Int)
    fileInfo [Char]
    fp = FileStatus -> (Int, Int, Int, Int)
    forall {b} {c}. (Num b, Num c) => FileStatus -> (Int, b, c, Int)
    go (FileStatus -> (Int, Int, Int, Int))
    -> IO FileStatus -> IO (Int, Int, Int, Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> IO FileStatus
    POSIX.getFileStatus [Char]
    fp
      where go :: FileStatus -> (Int, b, c, Int)
    go FileStatus
    status = ( EpochTime -> Int
    forall a. Enum a => a -> Int
    fromEnum (EpochTime -> Int) -> EpochTime -> Int
    forall a b. (a -> b) -> a -> b
    $ FileStatus -> EpochTime
    POSIX.modificationTime FileStatus
    status
                        , UserID -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (UserID -> b) -> UserID -> b
    forall a b. (a -> b) -> a -> b
    $ FileStatus -> UserID
    POSIX.fileOwner FileStatus
    status
                        , GroupID -> c
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (GroupID -> c) -> GroupID -> c
    forall a b. (a -> b) -> a -> b
    $ FileStatus -> GroupID
    POSIX.fileGroup FileStatus
    status
                        , Int -> Int
    oct2dec (Int -> Int) -> (FileMode -> Int) -> FileMode -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FileMode -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (FileMode -> Int) -> FileMode -> Int
    forall a b. (a -> b) -> a -> b
    $ FileStatus -> FileMode
    POSIX.fileMode FileStatus
    status
                        )

    oct2dec :: Int -> Int
    oct2dec :: Int -> Int
    oct2dec = (Int -> Int -> Int) -> Int -> [Int] -> Int
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\Int
    a Int
    b -> Int
    a Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    b) Int
    0 ([Int] -> Int) -> (Int -> [Int]) -> Int -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> [Int]
    forall a. [a] -> [a]
    reverse ([Int] -> [Int]) -> (Int -> [Int]) -> Int -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> [Int]
    forall {t}. Integral t => t -> t -> [t]
    dec Int
    8
      where dec :: t -> t -> [t]
    dec t
    _ t
    0 = []
            dec t
    b t
    i = let (t
    rest, t
    last) = t
    i t -> t -> (t, t)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` t
    b
                      in t
    lastt -> [t] -> [t]
    forall a. a -> [a] -> [a]
    :t -> t -> [t]
    dec t
    b t
    rest

    #endif