haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-02-03 01:50:25 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Fix some warnings

Browse Source
This commit is contained in:
Michael Snoyman 2013-05-23 11:54:24 +03:00
parent 5c5406358f
commit 1e8e7c0980
3 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Stackage/InstallInfo.hs
View File

@ -9,7 +9,6 @@ import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Version (showVersion) import Data.Version (showVersion)
import qualified Distribution.Text import qualified Distribution.Text
import Distribution.Text (display)
import Distribution.Version (simplifyVersionRange, withinRange) import Distribution.Version (simplifyVersionRange, withinRange)
import Stackage.HaskellPlatform import Stackage.HaskellPlatform
import Stackage.LoadDatabase import Stackage.LoadDatabase

1
Stackage/NarrowDatabase.hs
View File

@ -7,7 +7,6 @@ import Prelude hiding (pi)
import Stackage.Types import Stackage.Types
import Stackage.Util import Stackage.Util
import System.Exit (exitFailure) import System.Exit (exitFailure)
import Distribution.Text (display)
-- | Narrow down the database to only the specified packages and all of -- | Narrow down the database to only the specified packages and all of
-- their dependencies. -- their dependencies.

14
Stackage/Uploads.hs
View File

@ -34,7 +34,6 @@ checkUploads allowedFP newAllowedFP = do
_ <- evaluate $ msize forbidden _ <- evaluate $ msize forbidden
unless (Map.null $ unMonoidMap allowed') $ do unless (Map.null $ unMonoidMap allowed') $ do
let fp = "new-allowed.txt"
putStrLn $ "Newly uploaded packages detected, writing to " ++ newAllowedFP putStrLn $ "Newly uploaded packages detected, writing to " ++ newAllowedFP
writeAllowed newAllowedFP allowed' writeAllowed newAllowedFP allowed'
@ -47,9 +46,16 @@ instance (Ord k, Monoid v) => Monoid (MonoidMap k v) where
MonoidMap x `mappend` MonoidMap y = MonoidMap $ Map.unionWith mappend x y MonoidMap x `mappend` MonoidMap y = MonoidMap $ Map.unionWith mappend x y
-- And some helper functions. -- And some helper functions.
mlookup :: Ord k => k -> MonoidMap k v -> Maybe v
mlookup k = Map.lookup k . unMonoidMap mlookup k = Map.lookup k . unMonoidMap
msingleton :: k -> v -> MonoidMap k v
msingleton k = MonoidMap . Map.singleton k msingleton k = MonoidMap . Map.singleton k
mkeys :: MonoidMap k v -> [k]
mkeys = Map.keys . unMonoidMap mkeys = Map.keys . unMonoidMap
msize :: MonoidMap k v -> Int
msize = Map.size . unMonoidMap msize = Map.size . unMonoidMap
type Version = String type Version = String
@ -106,7 +112,7 @@ updateAllowed uploads allowed =
go pkg = go pkg =
case (mlookup pkg uploads, mlookup pkg allowed) of case (mlookup pkg uploads, mlookup pkg allowed) of
(Nothing, Nothing) -> assert False (mempty, mempty) (Nothing, Nothing) -> assert False (mempty, mempty)
(Nothing, Just a) -> (mempty, mempty) (Nothing, Just _) -> (mempty, mempty)
(Just u, Nothing) -> (msingleton pkg $ getAllUsers u, mempty) (Just u, Nothing) -> (msingleton pkg $ getAllUsers u, mempty)
(Just u, Just a) -> (Just u, Just a) ->
let fval = mconcat $ map (check a) $ Map.toList u let fval = mconcat $ map (check a) $ Map.toList u
@ -119,8 +125,8 @@ updateAllowed uploads allowed =
getAllUsers = Set.fromList . map fst . Map.elems getAllUsers = Set.fromList . map fst . Map.elems
check :: Set UserName -> (Version, (UserName, UTCTime)) -> Map Version (UserName, UTCTime) check :: Set UserName -> (Version, (UserName, UTCTime)) -> Map Version (UserName, UTCTime)
check allowed (ver, (user, time)) check allowed' (ver, (user, time))
| user `Set.member` allowed = Map.empty | user `Set.member` allowed' = Map.empty
| otherwise = Map.singleton ver (user, time) | otherwise = Map.singleton ver (user, time)
writeAllowed :: FilePath -> Allowed -> IO () writeAllowed :: FilePath -> Allowed -> IO ()