fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

More polymorphism.

Browse Source
This commit is contained in:
Gregor Kleen 2017-10-05 14:13:51 +02:00
parent 0f0f77344f
commit 4191d65fc5
1 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Handler/Zip.hs
View File

@ -47,11 +47,14 @@ instance Default Zip.ZipInfo where
} }
consumeZip :: (ZipEntry -> YesodDB UniWorX a) -- ^ Insert entries into database consumeZip :: ( MonadBase b m
-> Sink ByteString (YesodDB UniWorX) (Zip.ZipInfo, [a]) , PrimMonad b
consumeZip insertEntry = Zip.unZipStream `fuseBoth` consumeZip' , MonadThrow m
) => (ZipEntry -> m a) -- ^ Handle entries (insert into database)
-> Sink ByteString m (Zip.ZipInfo, [a])
consumeZip handleEntry = Zip.unZipStream `fuseBoth` consumeZip'
where where
-- consumeZip' :: Sink (Either Zip.ZipEntry ByteString) (YesodDB UniWorX) [a] -- consumeZip' :: Sink (Either Zip.ZipEntry ByteString) m [a]
consumeZip' = do consumeZip' = do
input <- await input <- await
case input of case input of
@ -66,7 +69,7 @@ consumeZip insertEntry = Zip.unZipStream `fuseBoth` consumeZip'
zipEntryContents zipEntryContents
| hasTrailingPathSeparator zipEntryName = Nothing | hasTrailingPathSeparator zipEntryName = Nothing
| otherwise = Just $ Lazy.ByteString.fromChunks contentChunks | otherwise = Just $ Lazy.ByteString.fromChunks contentChunks
(:) <$> (lift $ insertEntry ZipEntry{..}) <*> consumeZip' (:) <$> (lift $ handleEntry ZipEntry{..}) <*> consumeZip'
accContents :: Monad m => Sink (Either a b) m [b] accContents :: Monad m => Sink (Either a b) m [b]
accContents = do accContents = do
input <- await input <- await