    {-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, CPP #-}
    {- Note: [The need for Ar.hs]
    Building `-staticlib` 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: concatinate 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/abailability
    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
    /= :: ArchiveEntry -> ArchiveEntry -> Bool
    $c/= :: ArchiveEntry -> ArchiveEntry -> Bool
    == :: ArchiveEntry -> ArchiveEntry -> Bool
    $c== :: 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
    showList :: [ArchiveEntry] -> ShowS
    $cshowList :: [ArchiveEntry] -> ShowS
    show :: ArchiveEntry -> [Char]
    $cshow :: ArchiveEntry -> [Char]
    showsPrec :: Int -> ArchiveEntry -> ShowS
    $cshowsPrec :: Int -> 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
    /= :: Archive -> Archive -> Bool
    $c/= :: Archive -> Archive -> Bool
    == :: Archive -> Archive -> Bool
    $c== :: 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
    showList :: [Archive] -> ShowS
    $cshowList :: [Archive] -> ShowS
    show :: Archive -> [Char]
    $cshow :: Archive -> [Char]
    showsPrec :: Int -> Archive -> ShowS
    $cshowsPrec :: Int -> 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
    stimes :: forall b. Integral b => b -> Archive -> Archive
    $cstimes :: forall b. Integral b => b -> Archive -> Archive
    sconcat :: NonEmpty Archive -> Archive
    $csconcat :: NonEmpty Archive -> Archive
    <> :: Archive -> Archive -> Archive
    $c<> :: Archive -> 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
    mconcat :: [Archive] -> Archive
    $cmconcat :: [Archive] -> Archive
    mappend :: Archive -> Archive -> Archive
    $cmappend :: Archive -> Archive -> Archive
    mempty :: Archive
    $cmempty :: 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
        Bool
    empty <- Get Bool
    isEmpty
        if Bool
    empty then
            [ArchiveEntry] -> Get [ArchiveEntry]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
         else do
            ByteString
    name    <- Int -> Get ByteString
    getByteString Int
    16
            Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Char
    '/' Char -> ByteString -> Bool
    `C.elem` ByteString
    name Bool -> Bool -> Bool
    && Int -> ByteString -> ByteString
    C.take Int
    3 ByteString
    name ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    "#1/") (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
              [Char] -> Get ()
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "Looks like GNU Archive"
            Int
    time    <- ByteString -> Int
    getPaddedInt (ByteString -> Int) -> Get ByteString -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get ByteString
    getByteString Int
    12
            Int
    own     <- ByteString -> Int
    getPaddedInt (ByteString -> Int) -> Get ByteString -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get ByteString
    getByteString Int
    6
            Int
    grp     <- ByteString -> Int
    getPaddedInt (ByteString -> Int) -> Get ByteString -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get ByteString
    getByteString Int
    6
            Int
    mode    <- ByteString -> Int
    getPaddedInt (ByteString -> Int) -> Get ByteString -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get ByteString
    getByteString Int
    8
            Int
    st_size <- ByteString -> Int
    getPaddedInt (ByteString -> Int) -> Get ByteString -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get ByteString
    getByteString Int
    10
            ByteString
    end     <- Int -> Get ByteString
    getByteString Int
    2
            Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ByteString
    end ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    "\x60\x0a") (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
              [Char] -> Get ()
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "[BSD Archive] Invalid archive header end marker for name: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                    ByteString -> [Char]
    C.unpack ByteString
    name)
            Int
    off1    <- (Int64 -> Int) -> Get Int64 -> Get Int
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Get Int64
    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.
            [Char]
    name    <- if ByteString -> [Char]
    C.unpack (Int -> ByteString -> ByteString
    C.take Int
    3 ByteString
    name) [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "#1/" then
                            (ByteString -> [Char]) -> Get ByteString -> Get [Char]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (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
    '\0')) (Int -> Get ByteString
    getByteString (Int -> Get ByteString) -> Int -> Get ByteString
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Int
    forall a. Read a => [Char] -> a
    read ([Char] -> Int) -> [Char] -> Int
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Char]
    C.unpack (ByteString -> [Char]) -> ByteString -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Int -> ByteString -> ByteString
    C.drop Int
    3 ByteString
    name)
                        else
                            [Char] -> Get [Char]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> Get [Char]) -> [Char] -> Get [Char]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Char]
    C.unpack (ByteString -> [Char]) -> ByteString -> [Char]
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> ByteString -> ByteString
    C.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ' ') ByteString
    name
            Int
    off2    <- (Int64 -> Int) -> Get Int64 -> Get Int
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Get Int64
    bytesRead :: Get Int
            ByteString
    file    <- Int -> Get ByteString
    getByteString (Int
    st_size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    off2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    off1))
            -- data sections are two byte aligned (see #15396)
            Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int -> Bool
    forall a. Integral a => a -> Bool
    odd Int
    st_size) (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
              Get ByteString -> Get ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Int -> Get ByteString
    getByteString Int
    1)

            [ArchiveEntry]
    rest    <- Get [ArchiveEntry]
    getBSDArchEntries
            [ArchiveEntry] -> Get [ArchiveEntry]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([ArchiveEntry] -> Get [ArchiveEntry])
    -> [ArchiveEntry] -> Get [ArchiveEntry]
    forall a b. (a -> b) -> a -> b
    $ ([Char]
    -> Int -> Int -> Int -> Int -> Int -> ByteString -> ArchiveEntry
    ArchiveEntry [Char]
    name Int
    time Int
    own Int
    grp Int
    mode (Int
    st_size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    off2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    off1)) ByteString
    file) ArchiveEntry -> [ArchiveEntry] -> [ArchiveEntry]
    forall a. a -> [a] -> [a]
    : [ArchiveEntry]
    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
      Bool
    empty <- Get Bool
    isEmpty
      if Bool
    empty
        then [ArchiveEntry] -> Get [ArchiveEntry]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        else
        do
          ByteString
    name    <- Int -> Get ByteString
    getByteString Int
    16
          Int
    time    <- ByteString -> Int
    getPaddedInt (ByteString -> Int) -> Get ByteString -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get ByteString
    getByteString Int
    12
          Int
    own     <- ByteString -> Int
    getPaddedInt (ByteString -> Int) -> Get ByteString -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get ByteString
    getByteString Int
    6
          Int
    grp     <- ByteString -> Int
    getPaddedInt (ByteString -> Int) -> Get ByteString -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get ByteString
    getByteString Int
    6
          Int
    mode    <- ByteString -> Int
    getPaddedInt (ByteString -> Int) -> Get ByteString -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get ByteString
    getByteString Int
    8
          Int
    st_size <- ByteString -> Int
    getPaddedInt (ByteString -> Int) -> Get ByteString -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get ByteString
    getByteString Int
    10
          ByteString
    end     <- Int -> Get ByteString
    getByteString Int
    2
          Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ByteString
    end ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    "\x60\x0a") (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
            [Char] -> Get ()
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "[BSD Archive] Invalid archive header end marker for name: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                  ByteString -> [Char]
    C.unpack ByteString
    name)
          ByteString
    file <- Int -> Get ByteString
    getByteString Int
    st_size
          -- data sections are two byte aligned (see #15396)
          Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int -> Bool
    forall a. Integral a => a -> Bool
    odd Int
    st_size) (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
            Get ByteString -> Get ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Int -> Get ByteString
    getByteString Int
    1)
          [Char]
    name <- [Char] -> Get [Char]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> Get [Char])
    -> (ByteString -> [Char]) -> ByteString -> Get [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [Char]
    C.unpack (ByteString -> Get [Char]) -> ByteString -> Get [Char]
    forall a b. (a -> b) -> a -> b
    $
            if ByteString -> [Char]
    C.unpack (Int -> ByteString -> ByteString
    C.take Int
    1 ByteString
    name) [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "/"
            then case (Char -> Bool) -> ByteString -> ByteString
    C.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ' ') ByteString
    name of
                   name :: ByteString
    name@ByteString
    "/"  -> ByteString
    name               -- symbol table
                   name :: ByteString
    name@ByteString
    "//" -> ByteString
    name               -- extendedn 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 (Char -> Bool) -> ByteString -> ByteString
    C.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '/') ByteString
    name
          case [Char]
    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 extenden 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 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    pad)
      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
      [Char]
    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 [Char]
    magic [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Char]
    "!<arch>\n"
        then [Char] -> Get ()
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> Get ()) -> [Char] -> Get ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Invalid magic number " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> [Char]
    show [Char]
    magic
        else () -> Get ()
    forall (m :: * -> *) a. Monad m => a -> m a
    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 (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 (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 (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 (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 :: [Char]
    filename = [Char]
    "#1/" [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    sz
                                   , filedata :: ByteString
    filedata = [Char] -> ByteString
    C.pack (Char -> Int -> ShowS
    forall {a}. a -> Int -> [a] -> [a]
    padStr Char
    '\0' Int
    sz [Char]
    name) ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ArchiveEntry -> ByteString
    filedata ArchiveEntry
    archive
                                   , filesize :: Int
    filesize = Int
    st_size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    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 (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 :: Int
    filesize = ArchiveEntry -> Int
    filesize ArchiveEntry
    extInfo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Char] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    name Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2
                                        ,  filedata :: ByteString
    filedata = ArchiveEntry -> ByteString
    filedata ArchiveEntry
    extInfo ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <>  [Char] -> ByteString
    C.pack [Char]
    name ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    "/\n" }
                               , ArchiveEntry
    archive { filename :: [Char]
    filename = [Char]
    "/" [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> [Char]
    forall a. Show a => a -> [Char]
    show (ArchiveEntry -> Int
    filesize ArchiveEntry
    extInfo) } )
          | Bool
    otherwise        = ( ArchiveEntry
    extInfo, ArchiveEntry
    archive { filename :: [Char]
    filename = [Char]
    name [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    "/" } )

        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 (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
      ByteString
    payload <- [Char] -> IO ByteString
    B.readFile [Char]
    fp
      (Int
    modt, Int
    own, Int
    grp, Int
    mode) <- [Char] -> IO (Int, Int, Int, Int)
    fileInfo [Char]
    fp
      ArchiveEntry -> IO ArchiveEntry
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ArchiveEntry -> IO ArchiveEntry)
    -> ArchiveEntry -> IO ArchiveEntry
    forall a b. (a -> b) -> a -> b
    $ [Char]
    -> Int -> Int -> Int -> Int -> Int -> ByteString -> ArchiveEntry
    ArchiveEntry
        (ShowS
    takeFileName [Char]
    fp) Int
    modt Int
    own Int
    grp Int
    mode
        (ByteString -> Int
    B.length ByteString
    payload) ByteString
    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 (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