haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-02-07 16:47:27 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Make Hoogle URLs more consistent with other URLs

Browse Source
This commit is contained in:
Michael Snoyman 2015-01-04 14:13:47 +02:00
parent 10e255c3cc
commit 0b7d1e4bd0
4 changed files with 5 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Handler/Alias.hs
View File

@ -9,6 +9,7 @@ import Data.Slug (Slug)
import Handler.StackageHome (getStackageHomeR, getStackageMetadataR, getStackageCabalConfigR, getSnapshotPackagesR, getDocsR) import Handler.StackageHome (getStackageHomeR, getStackageMetadataR, getStackageCabalConfigR, getSnapshotPackagesR, getDocsR)
import Handler.StackageIndex (getStackageIndexR, getStackageBundleR) import Handler.StackageIndex (getStackageIndexR, getStackageBundleR)
import Handler.StackageSdist (getStackageSdistR) import Handler.StackageSdist (getStackageSdistR)
import Handler.Hoogle (getHoogleR)
handleAliasR :: Slug -> Slug -> [Text] -> Handler () handleAliasR :: Slug -> Slug -> [Text] -> Handler ()
handleAliasR user name pieces = do handleAliasR user name pieces = do
@ -77,4 +78,5 @@ goSid sid pieces = do
StackageSdistR pnv -> getStackageSdistR slug pnv >>= sendResponse StackageSdistR pnv -> getStackageSdistR slug pnv >>= sendResponse
SnapshotPackagesR -> getSnapshotPackagesR slug >>= sendResponse SnapshotPackagesR -> getSnapshotPackagesR slug >>= sendResponse
DocsR -> getDocsR slug >>= sendResponse DocsR -> getDocsR slug >>= sendResponse
HoogleR -> getHoogleR slug >>= sendResponse
_ -> notFound _ -> notFound

2
Handler/Hoogle.hs
View File

@ -46,7 +46,7 @@ getHoogleR slug = do
} }
Nothing -> return $ HoogleQueryOutput "" [] Nothing Nothing -> return $ HoogleQueryOutput "" [] Nothing
let queryText = fromMaybe "" mquery let queryText = fromMaybe "" mquery
pageLink p = (HoogleR slug pageLink p = (SnapshotR slug HoogleR
, (if exact then (("exact", "true"):) else id) , (if exact then (("exact", "true"):) else id)
$ (maybe id (\q' -> (("q", q'):)) mquery) $ (maybe id (\q' -> (("q", q'):)) mquery)
[("page", tshow p)]) [("page", tshow p)])

2
config/routes
View File

@ -25,6 +25,7 @@
/package/#PackageNameVersion StackageSdistR GET /package/#PackageNameVersion StackageSdistR GET
/packages SnapshotPackagesR GET /packages SnapshotPackagesR GET
/docs DocsR GET /docs DocsR GET
/hoogle HoogleR GET
/hackage-view/#HackageView/00-index.tar.gz HackageViewIndexR GET /hackage-view/#HackageView/00-index.tar.gz HackageViewIndexR GET
/hackage-view/#HackageView/package/#PackageNameVersion HackageViewSdistR GET /hackage-view/#HackageView/package/#PackageNameVersion HackageViewSdistR GET
@ -33,7 +34,6 @@
/progress/#Int ProgressR GET /progress/#Int ProgressR GET
/system SystemR GET /system SystemR GET
/haddock/#SnapSlug/*Texts HaddockR GET /haddock/#SnapSlug/*Texts HaddockR GET
/hoogle/#SnapSlug HoogleR GET
/package/#PackageName PackageR GET /package/#PackageName PackageR GET
/package/#PackageName/snapshots PackageSnapshotsR GET /package/#PackageName/snapshots PackageSnapshotsR GET
/package PackageListR GET /package PackageListR GET

2
templates/hoogle-form.hamlet
View File

@ -1,4 +1,4 @@
<form .hoogle action=@{HoogleR slug}> <form .hoogle action=@{SnapshotR slug HoogleR}>
<input type=search autofocus name=q value=#{queryText} placeholder="Hoogle Search Phrase" .search> <input type=search autofocus name=q value=#{queryText} placeholder="Hoogle Search Phrase" .search>
<input .btn type="submit" value="Search"> <input .btn type="submit" value="Search">
<label .checkbox .exact-lookup for=exact title="Only find identifiers matching your search term precisely"> <label .checkbox .exact-lookup for=exact title="Only find identifiers matching your search term precisely">