mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-02-26 01:17:53 +01:00
cabal.config added back
This commit is contained in:
parent
8c23324d60
commit
e71b8c036b
@ -25,10 +25,8 @@ getStackageHomeR name = do
|
|||||||
where strip x = fromMaybe x (stripSuffix "." x)
|
where strip x = fromMaybe x (stripSuffix "." x)
|
||||||
|
|
||||||
getStackageCabalConfigR :: SnapName -> Handler TypedContent
|
getStackageCabalConfigR :: SnapName -> Handler TypedContent
|
||||||
getStackageCabalConfigR slug = do
|
getStackageCabalConfigR name = do
|
||||||
error "getStackageCabalConfigR"
|
Entity sid snapshot <- lookupSnapshot name >>= maybe notFound return
|
||||||
{-
|
|
||||||
Entity sid _ <- runDB $ getBy404 $ UniqueSnapshot slug
|
|
||||||
render <- getUrlRender
|
render <- getUrlRender
|
||||||
|
|
||||||
mdownload <- lookupGetParam "download"
|
mdownload <- lookupGetParam "download"
|
||||||
@ -38,16 +36,14 @@ getStackageCabalConfigR slug = do
|
|||||||
mglobal <- lookupGetParam "global"
|
mglobal <- lookupGetParam "global"
|
||||||
let isGlobal = mglobal == Just "true"
|
let isGlobal = mglobal == Just "true"
|
||||||
|
|
||||||
respondSourceDB typePlain $ stream isGlobal render sid
|
plis <- getPackages sid
|
||||||
where
|
|
||||||
stream isGlobal render sid =
|
|
||||||
selectSource
|
|
||||||
[ PackageStackage ==. sid
|
|
||||||
]
|
|
||||||
[ Asc PackageName'
|
|
||||||
, Asc PackageVersion
|
|
||||||
] $= (if isGlobal then conduitGlobal else conduitLocal) render
|
|
||||||
|
|
||||||
|
respondSource typePlain $ yieldMany plis $=
|
||||||
|
if isGlobal
|
||||||
|
then conduitGlobal render
|
||||||
|
else conduitLocal render
|
||||||
|
where
|
||||||
|
-- FIXME move this stuff into stackage-common
|
||||||
conduitGlobal render = do
|
conduitGlobal render = do
|
||||||
headerGlobal render
|
headerGlobal render
|
||||||
mapC (Chunk . showPackageGlobal)
|
mapC (Chunk . showPackageGlobal)
|
||||||
@ -62,7 +58,7 @@ getStackageCabalConfigR slug = do
|
|||||||
toBuilder (asText "-- Stackage snapshot from: ") ++
|
toBuilder (asText "-- Stackage snapshot from: ") ++
|
||||||
toBuilder (snapshotUrl render) ++
|
toBuilder (snapshotUrl render) ++
|
||||||
toBuilder (asText "\n-- Please place these contents in your global cabal config file.\n-- To only use tested packages, uncomment the following line\n-- and comment out other remote-repo lines:\n-- remote-repo: stackage-") ++
|
toBuilder (asText "\n-- Please place these contents in your global cabal config file.\n-- To only use tested packages, uncomment the following line\n-- and comment out other remote-repo lines:\n-- remote-repo: stackage-") ++
|
||||||
toBuilder (toPathPiece slug) ++
|
toBuilder (toPathPiece name) ++
|
||||||
toBuilder ':' ++
|
toBuilder ':' ++
|
||||||
toBuilder (snapshotUrl render) ++
|
toBuilder (snapshotUrl render) ++
|
||||||
toBuilder '\n'
|
toBuilder '\n'
|
||||||
@ -71,12 +67,12 @@ getStackageCabalConfigR slug = do
|
|||||||
toBuilder (asText "-- Stackage snapshot from: ") ++
|
toBuilder (asText "-- Stackage snapshot from: ") ++
|
||||||
toBuilder (snapshotUrl render) ++
|
toBuilder (snapshotUrl render) ++
|
||||||
toBuilder (asText "\n-- Please place this file next to your .cabal file as cabal.config\n-- To only use tested packages, uncomment the following line:\n-- remote-repo: stackage-") ++
|
toBuilder (asText "\n-- Please place this file next to your .cabal file as cabal.config\n-- To only use tested packages, uncomment the following line:\n-- remote-repo: stackage-") ++
|
||||||
toBuilder (toPathPiece slug) ++
|
toBuilder (toPathPiece name) ++
|
||||||
toBuilder ':' ++
|
toBuilder ':' ++
|
||||||
toBuilder (snapshotUrl render) ++
|
toBuilder (snapshotUrl render) ++
|
||||||
toBuilder '\n'
|
toBuilder '\n'
|
||||||
|
|
||||||
snapshotUrl render = asHttp $ render $ SnapshotR slug StackageHomeR
|
snapshotUrl render = asHttp $ render $ SnapshotR name StackageHomeR
|
||||||
|
|
||||||
asHttp (stripPrefix "http://" -> Just s) = "http://" <> s
|
asHttp (stripPrefix "http://" -> Just s) = "http://" <> s
|
||||||
asHttp (stripPrefix "https://" -> Just s) = "http://" <> s
|
asHttp (stripPrefix "https://" -> Just s) = "http://" <> s
|
||||||
@ -84,28 +80,27 @@ getStackageCabalConfigR slug = do
|
|||||||
asHttp s = error $ "Unexpected url prefix: " <> unpack s
|
asHttp s = error $ "Unexpected url prefix: " <> unpack s
|
||||||
|
|
||||||
constraint p
|
constraint p
|
||||||
| Just True <- packageCore p = toBuilder $ asText " installed"
|
| pliIsCore p = toBuilder $ asText " installed"
|
||||||
| otherwise = toBuilder (asText " ==") ++
|
| otherwise = toBuilder (asText " ==") ++
|
||||||
toBuilder (toPathPiece $ packageVersion p)
|
toBuilder (pliVersion p)
|
||||||
|
|
||||||
showPackageGlobal (Entity _ p) =
|
showPackageGlobal p =
|
||||||
toBuilder (asText "constraint: ") ++
|
toBuilder (asText "constraint: ") ++
|
||||||
toBuilder (toPathPiece $ packageName' p) ++
|
toBuilder (pliName p) ++
|
||||||
constraint p ++
|
constraint p ++
|
||||||
toBuilder '\n'
|
toBuilder '\n'
|
||||||
|
|
||||||
goFirst = do
|
goFirst = do
|
||||||
mx <- await
|
mx <- await
|
||||||
forM_ mx $ \(Entity _ p) -> yield $ Chunk $
|
forM_ mx $ \p -> yield $ Chunk $
|
||||||
toBuilder (asText "constraints: ") ++
|
toBuilder (asText "constraints: ") ++
|
||||||
toBuilder (toPathPiece $ packageName' p) ++
|
toBuilder (pliName p) ++
|
||||||
constraint p
|
constraint p
|
||||||
|
|
||||||
showPackageLocal (Entity _ p) =
|
showPackageLocal p =
|
||||||
toBuilder (asText ",\n ") ++
|
toBuilder (asText ",\n ") ++
|
||||||
toBuilder (toPathPiece $ packageName' p) ++
|
toBuilder (pliName p) ++
|
||||||
constraint p
|
constraint p
|
||||||
-}
|
|
||||||
|
|
||||||
yearMonthDay :: FormatTime t => t -> String
|
yearMonthDay :: FormatTime t => t -> String
|
||||||
yearMonthDay = formatTime defaultTimeLocale "%Y-%m-%d"
|
yearMonthDay = formatTime defaultTimeLocale "%Y-%m-%d"
|
||||||
|
|||||||
@ -268,6 +268,7 @@ data PackageListingInfo = PackageListingInfo
|
|||||||
{ pliName :: !Text
|
{ pliName :: !Text
|
||||||
, pliVersion :: !Text
|
, pliVersion :: !Text
|
||||||
, pliSynopsis :: !Text
|
, pliSynopsis :: !Text
|
||||||
|
, pliIsCore :: !Bool
|
||||||
}
|
}
|
||||||
|
|
||||||
getPackages :: GetStackageDatabase m => SnapshotId -> m [PackageListingInfo]
|
getPackages :: GetStackageDatabase m => SnapshotId -> m [PackageListingInfo]
|
||||||
@ -281,10 +282,12 @@ getPackages sid = liftM (map toPLI) $ run $ do
|
|||||||
( p E.^. PackageName
|
( p E.^. PackageName
|
||||||
, p E.^. PackageSynopsis
|
, p E.^. PackageSynopsis
|
||||||
, sp E.^. SnapshotPackageVersion
|
, sp E.^. SnapshotPackageVersion
|
||||||
|
, sp E.^. SnapshotPackageIsCore
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
toPLI (E.Value name, E.Value synopsis, E.Value version) = PackageListingInfo
|
toPLI (E.Value name, E.Value synopsis, E.Value version, E.Value isCore) = PackageListingInfo
|
||||||
{ pliName = name
|
{ pliName = name
|
||||||
, pliVersion = version
|
, pliVersion = version
|
||||||
, pliSynopsis = synopsis
|
, pliSynopsis = synopsis
|
||||||
|
, pliIsCore = isCore
|
||||||
}
|
}
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user