From 11f0d37904d49a60bb5069a898e13eb62adadbc2 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sat, 18 Oct 2014 19:43:57 +0300
Subject: [PATCH] cabal.config link

---
 Handler/StackageHome.hs        | 30 ++++++++++++++++++++++++++++++
 config/routes                  |  1 +
 templates/stackage-home.hamlet |  4 ++++
 3 files changed, 35 insertions(+)

diff --git a/Handler/StackageHome.hs b/Handler/StackageHome.hs
index 26e20b0..c6f0b9a 100644
--- a/Handler/StackageHome.hs
+++ b/Handler/StackageHome.hs
@@ -2,6 +2,7 @@ module Handler.StackageHome where
 
 import Data.BlobStore (storeExists)
 import Import
+import Data.Time (FormatTime)
 
 getStackageHomeR :: PackageSetIdent -> Handler Html
 getStackageHomeR ident = do
@@ -49,4 +50,33 @@ getStackageMetadataR ident = do
         , "\n"
         ]
 
+getStackageCabalConfigR :: PackageSetIdent -> Handler TypedContent
+getStackageCabalConfigR ident = do
+    Entity sid _ <- runDB $ getBy404 $ UniqueStackage ident
+    respondSourceDB typePlain $ stream sid
+  where
+    stream sid =
+        selectSource
+            [ PackageStackage ==. sid
+            , PackageOverwrite ==. False
+            ]
+            [ Asc PackageName'
+            , Asc PackageVersion
+            ] $= (goFirst >> mapC (Chunk . showPackage))
+
+    goFirst = do
+        mx <- await
+        forM_ mx $ \(Entity _ (Package _ name version _)) -> yield $ Chunk $
+            toBuilder (asText "constraints: ") ++
+            toBuilder (toPathPiece name) ++
+            toBuilder (asText " ==") ++
+            toBuilder (toPathPiece version)
+
+    showPackage (Entity _ (Package _ name version _)) =
+        toBuilder (asText ",\n             ") ++
+        toBuilder (toPathPiece name) ++
+        toBuilder (asText " ==") ++
+        toBuilder (toPathPiece version)
+
+yearMonthDay :: FormatTime t => t -> String
 yearMonthDay = formatTime defaultTimeLocale "%Y-%m-%d"
diff --git a/config/routes b/config/routes
index d15243b..bb2bed0 100644
--- a/config/routes
+++ b/config/routes
@@ -12,6 +12,7 @@
 /upload UploadStackageR GET PUT
 /stackage/#PackageSetIdent StackageHomeR GET
 /stackage/#PackageSetIdent/metadata StackageMetadataR GET
+/stackage/#PackageSetIdent/cabal.config StackageCabalConfigR GET
 /stackage/#PackageSetIdent/00-index.tar.gz StackageIndexR GET
 /stackage/#PackageSetIdent/bundle StackageBundleR GET
 /stackage/#PackageSetIdent/package/#PackageNameVersion StackageSdistR GET
diff --git a/templates/stackage-home.hamlet b/templates/stackage-home.hamlet
index 1f89285..2c3052d 100644
--- a/templates/stackage-home.hamlet
+++ b/templates/stackage-home.hamlet
@@ -13,6 +13,10 @@ $newline never
            <span>
                <a href=@{StackageBundleR ident} title="This is useful for making modifications to an existing snapshot">
                    \Bundle
+           <span .separator>
+           <span>
+               <a href=@{StackageCabalConfigR ident} title="If you want to stick with upstream Hackage but get a stable package set">
+                   \cabal.config
     <p>
         <pre>
             remote-repo: stackage:@{StackageHomeR ident}