mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-21 16:31:56 +01:00
Replace runUploadState with mapM liftIO
This commit is contained in:
parent
70a59af6c1
commit
f52c0010dc
@ -50,7 +50,7 @@ loadCabalFiles :: ( MonadActive m
|
|||||||
-> Bool -- ^ force updates regardless of hash value?
|
-> Bool -- ^ force updates regardless of hash value?
|
||||||
-> HashMap PackageName (Version, ByteString)
|
-> HashMap PackageName (Version, ByteString)
|
||||||
-> m (UploadState Metadata)
|
-> m (UploadState Metadata)
|
||||||
loadCabalFiles dbUpdates forceUpdate metadata0 = (>>= runUploadState) $ flip execStateT (UploadState metadata1 mempty) $ do
|
loadCabalFiles dbUpdates forceUpdate metadata0 = (>>= T.mapM liftIO) $ flip execStateT (UploadState metadata1 mempty) $ do
|
||||||
HackageRoot root <- liftM getHackageRoot ask
|
HackageRoot root <- liftM getHackageRoot ask
|
||||||
$logDebug $ "Entering loadCabalFiles, root == " ++ root
|
$logDebug $ "Entering loadCabalFiles, root == " ++ root
|
||||||
req <- parseUrl $ unpack $ root ++ "/00-index.tar.gz"
|
req <- parseUrl $ unpack $ root ++ "/00-index.tar.gz"
|
||||||
@ -114,9 +114,6 @@ readVersion v =
|
|||||||
(dv, _):_ -> Just $ pack $ Data.Version.versionBranch dv
|
(dv, _):_ -> Just $ pack $ Data.Version.versionBranch dv
|
||||||
[] -> Nothing
|
[] -> Nothing
|
||||||
|
|
||||||
runUploadState :: MonadIO m => UploadState (IO a) -> m (UploadState a)
|
|
||||||
runUploadState (UploadState y z) = liftIO $ UploadState y <$> T.sequence z
|
|
||||||
|
|
||||||
tarSource :: (Exception e, MonadThrow m)
|
tarSource :: (Exception e, MonadThrow m)
|
||||||
=> Tar.Entries e
|
=> Tar.Entries e
|
||||||
-> Producer m Tar.Entry
|
-> Producer m Tar.Entry
|
||||||
@ -128,6 +125,7 @@ data UploadState md = UploadState
|
|||||||
{ usMetadata :: !(HashMap PackageName MetaSig)
|
{ usMetadata :: !(HashMap PackageName MetaSig)
|
||||||
, usMetaChanges :: (HashMap PackageName md)
|
, usMetaChanges :: (HashMap PackageName md)
|
||||||
}
|
}
|
||||||
|
deriving (Functor, Foldable, Traversable)
|
||||||
|
|
||||||
data MetaSig = MetaSig
|
data MetaSig = MetaSig
|
||||||
{-# UNPACK #-} !Version
|
{-# UNPACK #-} !Version
|
||||||
|
|||||||
@ -85,6 +85,9 @@ library
|
|||||||
BangPatterns
|
BangPatterns
|
||||||
TupleSections
|
TupleSections
|
||||||
DeriveGeneric
|
DeriveGeneric
|
||||||
|
DeriveFunctor
|
||||||
|
DeriveFoldable
|
||||||
|
DeriveTraversable
|
||||||
|
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4
|
base >= 4
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user