diff --git a/Handler/StackageHome.hs b/Handler/StackageHome.hs index f067719..afe9371 100644 --- a/Handler/StackageHome.hs +++ b/Handler/StackageHome.hs @@ -88,10 +88,10 @@ getStackageMetadataR slug = do , Asc PackageVersion ] $= mapC (Chunk . toBuilder . showPackage) - showPackage (Entity _ (Package _ name version _ _)) = concat - [ toPathPiece name + showPackage (Entity _ p) = concat + [ toPathPiece $ packageName' p , "-" - , toPathPiece version + , toPathPiece $ packageVersion p , "\n" ] @@ -128,17 +128,20 @@ getStackageCabalConfigR slug = do toBuilder '\n' goFirst = do mx <- await - forM_ mx $ \(Entity _ (Package _ name version _ _)) -> yield $ Chunk $ + forM_ mx $ \(Entity _ p) -> yield $ Chunk $ toBuilder (asText "constraints: ") ++ - toBuilder (toPathPiece name) ++ - toBuilder (asText " ==") ++ - toBuilder (toPathPiece version) + toBuilder (toPathPiece $ packageName' p) ++ + constraint p - showPackage (Entity _ (Package _ name version _ _)) = + constraint p + | packageCore p = toBuilder $ asText " installed" + | otherwise = toBuilder (asText " ==") ++ + toBuilder (toPathPiece $ packageVersion p) + + showPackage (Entity _ p) = toBuilder (asText ",\n ") ++ - toBuilder (toPathPiece name) ++ - toBuilder (asText " ==") ++ - toBuilder (toPathPiece version) + toBuilder (toPathPiece $ packageName' p) ++ + constraint p yearMonthDay :: FormatTime t => t -> String yearMonthDay = formatTime defaultTimeLocale "%Y-%m-%d" diff --git a/Handler/UploadStackage.hs b/Handler/UploadStackage.hs index 12a69b3..5784a97 100644 --- a/Handler/UploadStackage.hs +++ b/Handler/UploadStackage.hs @@ -13,7 +13,7 @@ import qualified Data.Text as T import Filesystem.Path (splitExtension) import Data.BlobStore import Filesystem (createTree) -import Control.Monad.State.Strict (execStateT, get, put) +import Control.Monad.State.Strict (execStateT, get, put, modify) import qualified Codec.Compression.GZip as GZip import Control.Monad.Trans.Resource (allocate) import System.Directory (removeFile, getTemporaryDirectory) @@ -127,12 +127,13 @@ putUploadStackageR = do -- Evil lazy I/O thanks to tar package lbs <- readFile $ fpFromString fp withSystemTempDirectory "build00index." $ \dir -> do - LoopState _ stackage files _ contents <- execStateT (loop isAdmin update (Tar.read lbs)) LoopState + LoopState _ stackage files _ contents cores <- execStateT (loop isAdmin update (Tar.read lbs)) LoopState { lsRoot = fpFromString dir , lsStackage = initial , lsFiles = mempty , lsIdent = ident , lsContents = [] + , lsCores = mempty } withSystemTempFile "newindex" $ \fp' h -> do ec <- liftIO $ do @@ -155,6 +156,7 @@ putUploadStackageR = do , packageVersion = version , packageOverwrite = overwrite , packageHasHaddocks = False + , packageCore = name `member` cores } setAlias @@ -215,6 +217,13 @@ putUploadStackageR = do Just src -> addFile False name version src Nothing -> return () + + "core" -> forM_ (lines $ decodeUtf8 $ toStrict lbs) $ \name -> + modify $ \ls -> ls + { lsCores = insertSet (PackageName name) + $ lsCores ls + } + fp | (base1, Just "gz") <- splitExtension fp , (fpToText -> base, Just "tar") <- splitExtension base1 -> do ident <- lsIdent <$> get @@ -266,6 +275,7 @@ data LoopState = LoopState , lsIdent :: !PackageSetIdent , lsContents :: ![(PackageName, Version, IsOverride)] -- FIXME use SnocVector when ready + , lsCores :: !(Set PackageName) -- ^ core packages } type IsOverride = Bool diff --git a/config/models b/config/models index 0b3d3d8..bf633f2 100644 --- a/config/models +++ b/config/models @@ -44,6 +44,7 @@ Package version Version hasHaddocks Bool default=true overwrite Bool + core Bool default=false Tag package PackageName