Zip UTF8-support
This commit is contained in:
parent
4a59f9ca64
commit
0cd0425903
@ -24,9 +24,6 @@ import qualified Data.ByteString.Lazy as Lazy.ByteString
|
|||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import qualified Data.ByteString as ByteString
|
import qualified Data.ByteString as ByteString
|
||||||
|
|
||||||
import qualified Data.Text as Text
|
|
||||||
import qualified Data.Text.Encoding as Text
|
|
||||||
|
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import Data.Time
|
import Data.Time
|
||||||
|
|
||||||
@ -52,14 +49,13 @@ consumeZip = unZipStream `fuseUpstream` consumeZip'
|
|||||||
case input of
|
case input of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just (Right _) -> throw $ userError "Data chunk in unexpected place when parsing ZIP"
|
Just (Right _) -> throw $ userError "Data chunk in unexpected place when parsing ZIP"
|
||||||
Just (Left e) -> do
|
Just (Left ZipEntry{..}) -> do
|
||||||
zipEntryName' <- fmap Text.unpack . either throw return . Text.decodeUtf8' $ zipEntryName e
|
|
||||||
contentChunks <- toConsumer accContents
|
contentChunks <- toConsumer accContents
|
||||||
let
|
let
|
||||||
fileTitle = normalise $ makeValid zipEntryName'
|
fileTitle = normalise $ makeValid zipEntryName
|
||||||
fileModified = localTimeToUTC utc $ zipEntryTime e
|
fileModified = localTimeToUTC utc zipEntryTime
|
||||||
fileContent
|
fileContent
|
||||||
| hasTrailingPathSeparator zipEntryName' = Nothing
|
| hasTrailingPathSeparator zipEntryName = Nothing
|
||||||
| otherwise = Just $ mconcat contentChunks
|
| otherwise = Just $ mconcat contentChunks
|
||||||
yield $ File{..}
|
yield $ File{..}
|
||||||
consumeZip'
|
consumeZip'
|
||||||
@ -89,7 +85,7 @@ produceZip info = mapC toZipData =$= void (zipStream zipOptions)
|
|||||||
|
|
||||||
toZipEntry :: File -> ZipEntry
|
toZipEntry :: File -> ZipEntry
|
||||||
toZipEntry File{..} = ZipEntry
|
toZipEntry File{..} = ZipEntry
|
||||||
{ zipEntryName = Text.encodeUtf8 . Text.pack . bool (dropWhileEnd isPathSeparator) addTrailingPathSeparator isDir . normalise . makeValid $ fileTitle
|
{ zipEntryName = bool (dropWhileEnd isPathSeparator) addTrailingPathSeparator isDir . normalise . makeValid $ fileTitle
|
||||||
, zipEntryTime = utcToLocalTime utc fileModified
|
, zipEntryTime = utcToLocalTime utc fileModified
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
|
|||||||
@ -12,7 +12,7 @@ packages:
|
|||||||
extra-dep: true
|
extra-dep: true
|
||||||
- location:
|
- location:
|
||||||
git: https://github.com/pngwjpgh/zip-stream.git
|
git: https://github.com/pngwjpgh/zip-stream.git
|
||||||
commit: f6a40e6d214653cf405186e72d4e1b79065ec2d0
|
commit: 9272bbed000928d500febad1cdc98d1da29d399e
|
||||||
extra-dep: true
|
extra-dep: true
|
||||||
extra-deps:
|
extra-deps:
|
||||||
- colonnade-1.1.1
|
- colonnade-1.1.1
|
||||||
@ -21,4 +21,7 @@ extra-deps:
|
|||||||
- uuid-crypto-1.3.0.0
|
- uuid-crypto-1.3.0.0
|
||||||
- cryptoids-0.3.0.0
|
- cryptoids-0.3.0.0
|
||||||
- cryptoids-types-0.0.0
|
- cryptoids-types-0.0.0
|
||||||
|
|
||||||
|
- encoding-0.8.2
|
||||||
|
- regex-compat-0.93.1
|
||||||
resolver: lts-9.3
|
resolver: lts-9.3
|
||||||
|
|||||||
Reference in New Issue
Block a user