git.iko.soy/elk
on master help sign in
Add File.writePackage for .zip files and make readBinary more lenient
436f495Evan Czaplicki
builder/src/File.hs+42−4
compare with master
unifiedsplit
@@ -7,6 +7,7 @@ module File
7 , writeUtf8
7 , writeUtf8
8 , readUtf8
8 , readUtf8
9 , writeBuilder
9 , writeBuilder
10+ , writePackage
10 , exists
11 , exists
11 , remove
12 , remove
12 , removeDir
13 , removeDir
@@ -14,18 +15,22 @@ module File
14 where
15 where
15
16
16
17
18+import qualified Codec.Archive.Zip as Zip
17import Control.Exception (catch)
19import Control.Exception (catch)
18import qualified Data.Binary as Binary
20import qualified Data.Binary as Binary
19import qualified Data.ByteString as BS
21import qualified Data.ByteString as BS
20import qualified Data.ByteString.Internal as BS
22import qualified Data.ByteString.Internal as BS
21import qualified Data.ByteString.Builder as B
23import qualified Data.ByteString.Builder as B
24+import qualified Data.ByteString.Lazy as LBS
22import qualified Data.Fixed as Fixed
25import qualified Data.Fixed as Fixed
26+import qualified Data.List as List
23import qualified Data.Time.Clock.POSIX as Time
27import qualified Data.Time.Clock.POSIX as Time
24import qualified Foreign.ForeignPtr as FPtr
28import qualified Foreign.ForeignPtr as FPtr
25import GHC.IO.Exception (IOException, IOErrorType(InvalidArgument))
29import GHC.IO.Exception (IOException, IOErrorType(InvalidArgument))
26import qualified System.Directory as Dir
30import qualified System.Directory as Dir
27import qualified System.FileLock as Lock
31import qualified System.FileLock as Lock
28import qualified System.FilePath as FP
32import qualified System.FilePath as FP
33+import System.FilePath ((</>))
29import qualified System.IO as IO
34import qualified System.IO as IO
30import System.IO.Error (ioeGetErrorType, annotateIOError, modifyIOError)
35import System.IO.Error (ioeGetErrorType, annotateIOError, modifyIOError)
31
36
@@ -73,10 +78,15 @@ writeBinary path value =
73
78
74readBinary :: (Binary.Binary a) => FilePath -> IO (Maybe a)
79readBinary :: (Binary.Binary a) => FilePath -> IO (Maybe a)
75readBinary path =
80readBinary path =
81+ do pathExists <- Dir.doesFileExist path
82+ if pathExists
83+ then
76− do result <- Binary.decodeFileOrFail path
84+ do result <- Binary.decodeFileOrFail path
77− case result of
85+ case result of
78− Right a -> return (Just a)
86+ Right a -> return (Just a)
79− Left _ -> return Nothing
87+ Left e -> return Nothing
88+ else
89+ return Nothing
80
90
81
91
82
92
@@ -153,6 +163,34 @@ writeBuilder path builder =
153
163
154
164
155
165
166+-- WRITE PACKAGE
167+
168+
169+writePackage :: FilePath -> Zip.Archive -> IO ()
170+writePackage destination archive =
171+ case Zip.zEntries archive of
172+ [] ->
173+ return ()
174+
175+ entry:entries ->
176+ do let root = length (Zip.eRelativePath entry)
177+ mapM_ (writeEntry destination root) entries
178+
179+
180+writeEntry :: FilePath -> Int -> Zip.Entry -> IO ()
181+writeEntry destination root entry =
182+ let
183+ path = drop root (Zip.eRelativePath entry)
184+ in
185+ if List.isPrefixOf "src/" path then
186+ if not (null path) && last path == '/'
187+ then Dir.createDirectoryIfMissing True (destination </> path)
188+ else LBS.writeFile (destination </> path) (Zip.fromEntry entry)
189+ else
190+ return ()
191+
192+
193+
156-- EXISTS
194-- EXISTS
157
195
158
196