{-# LANGUAGE PackageImports #-}
{-# OPTIONS_HADDOCK hide #-}

module Codec.Archive.Tar.PackAscii
  ( toPosixString
  , fromPosixString
  , posixToByteString
  , byteToPosixString
  , packAscii
  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS.Char8
import qualified Data.ByteString.Short as Sh
import Data.Char
import GHC.Stack
import System.IO.Unsafe (unsafePerformIO)
import "os-string" System.OsString.Posix (PosixString)
import qualified "os-string" System.OsString.Posix as PS
import qualified "os-string" System.OsString.Internal.Types as PS

toPosixString :: FilePath -> PosixString
toPosixString :: FilePath -> PosixString
toPosixString = IO PosixString -> PosixString
forall a. IO a -> a
unsafePerformIO (IO PosixString -> PosixString)
-> (FilePath -> IO PosixString) -> FilePath -> PosixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO PosixString
PS.encodeFS

fromPosixString :: PosixString -> FilePath
fromPosixString :: PosixString -> FilePath
fromPosixString = IO FilePath -> FilePath
forall a. IO a -> a
unsafePerformIO (IO FilePath -> FilePath)
-> (PosixString -> IO FilePath) -> PosixString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> IO FilePath
PS.decodeFS

posixToByteString :: PosixString -> ByteString
posixToByteString :: PosixString -> ByteString
posixToByteString = ShortByteString -> ByteString
Sh.fromShort (ShortByteString -> ByteString)
-> (PosixString -> ShortByteString) -> PosixString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> ShortByteString
PS.getPosixString

byteToPosixString :: ByteString -> PosixString
byteToPosixString :: ByteString -> PosixString
byteToPosixString = ShortByteString -> PosixString
PS.PosixString (ShortByteString -> PosixString)
-> (ByteString -> ShortByteString) -> ByteString -> PosixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
Sh.toShort

packAscii :: HasCallStack => FilePath -> BS.Char8.ByteString
packAscii :: HasCallStack => FilePath -> ByteString
packAscii FilePath
xs
  | (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii FilePath
xs = FilePath -> ByteString
BS.Char8.pack FilePath
xs
  | Bool
otherwise = FilePath -> ByteString
forall a. HasCallStack => FilePath -> a
error (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"packAscii: only ASCII inputs are supported, but got " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
xs