module Distribution.Server.Pages.Distributions ( homePage , adminHomePage , distroListing , distroPage , adminDistroPage ) where import Distribution.Server.Pages.Template (hackagePage) import Distribution.Server.Features.Distro.Distributions import Distribution.Server.Users.Types import Distribution.Text import Distribution.Package import qualified Happstack.Server.SURI as SURI import System.FilePath.Posix import Text.XHtml.Strict -- | List of known distributions homePage :: [DistroName] -> Html homePage = hackagePage "Distributions" . listing "/distro" -- | List of known distributions. Includes a form -- to add a new distribution. adminHomePage :: [DistroName] -> Html adminHomePage distros = hackagePage "Distributions" $ concat [ listing "/admin/distro" distros , addDistroForm ] -- | Display the packages in a distribution. The passed-in URL is the -- link to the admin page. distroListing :: DistroName -> [(PackageName, DistroPackageInfo)] -> URL -> Html distroListing distro packages adminLink = hackagePage (display distro) $ concat [ packageListing , adminLinkHtml ] where packageListing :: [Html] packageListing = [ h3 << ("Packages in " ++ display distro) , ulist << map (uncurry packageHtml) packages ] packageHtml pName pInfo = li << (display pName ++ " " ++ display (distroVersion pInfo)) adminLinkHtml = [ h3 << "Admin Tasks" , anchor ! [href adminLink] << "Administrative tasks" ] -- | Admin page for a distribution. Includes a list -- of the maintainers and a form to add maintainers. distroPage :: DistroName -> [UserName] -> Html distroPage distro users = hackagePage (display distro) $ concat [ addPackageForm distro , userList distro users , addUserForm distro ] addPackageForm :: DistroName -> [Html] addPackageForm distro = let actionUri = "/distro" SURI.escape distro "admin" "addPackage" in [ h3 << "Add a package" , gui actionUri ! [theclass "box"] << [ p << [stringToHtml "Package: ", textfield "packageName"] , p << [stringToHtml "Version: ", textfield "version"] , p << [stringToHtml "URL: ", textfield "uri"] , submit "submit" "Add package" ] ] addDistroForm :: [Html] addDistroForm = [ h3 << "Add Distribution" , gui "/admin/createDistro" ! [theclass "box"] << [ p << [stringToHtml "Name: ", textfield "distroName"] , submit "submit" "Add distribution" ] ] {- This should be updated to match the current URI scheme in the Distro feature. displayDir :: Text a => a -> String displayDir = escapeString f . display where f c = okInPath c && c /= '/' -- | Admin form for a distribution. Includes a list -- of the maintainers, a form to add maintainers and -- a button to destroy this distribution. adminDistroPage :: DistroName -> [UserName] -> Html adminDistroPage distro users = hackagePage (display distro) $ concat [ userList distro users , addUserForm distro , deleteDistro distro ] addUserForm :: DistroName -> [Html] addUserForm distro = [ h3 << "Add a maintainer" , gui ("/distro" displayDir distro "admin" "addMember") ! [theclass "box"] << [ p << [stringToHtml "User: ", textfield "userName"] , submit "submit" "Add user" ] ] deleteDistro :: DistroName -> [Html] deleteDistro distro = [ h3 << "Delete distribution" , gui ("/admin/distro" displayDir distro "delete") << submit "submit" "Delete Distribution" ] userList :: DistroName -> [UserName] -> [Html] userList distro users = [ h3 << "Maintainers" , ulist << map (userHtml distro) users ] userHtml :: DistroName -> UserName -> Html userHtml distro user = li << [ stringToHtml $ display user , removeUser user distro ] removeUser :: UserName -> DistroName -> Html removeUser user distro = gui ("/distro" displayDir distro "admin" "removeMember") << [ hidden "userName" $ display user , submit "submit" "Remove" ]-} listing :: FilePath -> [DistroName] -> [Html] listing rootPath distros = [ h3 << "Distributions" , ulist << map (distroHtml rootPath) distros ] distroHtml :: FilePath -> DistroName -> Html distroHtml rootPath distro = li << anchor ! [href $ rootPath SURI.escape distro ] << display distro