haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-29 04:10:24 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Start of implementation of wireframe

Browse Source
This commit is contained in:
Chris Done 2014-06-01 13:35:10 +02:00
parent 841c9f5c81
commit 4814d994dc
13 changed files with 141 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Application.hs
View File

@ -39,6 +39,7 @@ import qualified Echo
-- Import all relevant handler modules here. -- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file! -- Don't forget to add new modules to your cabal file!
import Handler.Home import Handler.Home
import Handler.Snapshots
import Handler.Profile import Handler.Profile
import Handler.Email import Handler.Email
import Handler.ResetToken import Handler.ResetToken
@ -152,7 +153,7 @@ makeFoundation useEcho conf = do
(messageLoggerSource foundation logger) (messageLoggerSource foundation logger)
-- Start the cabal file loader -- Start the cabal file loader
void $ forkIO $ forever $ flip runLoggingT (messageLoggerSource foundation logger) $ do {-void $ forkIO $ forever $ flip runLoggingT (messageLoggerSource foundation logger) $ do
$logInfoS "CLEANUP" "Cleaning up /tmp" $logInfoS "CLEANUP" "Cleaning up /tmp"
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
runResourceT $ sourceDirectory "/tmp" $$ mapM_C (cleanupTemp now) runResourceT $ sourceDirectory "/tmp" $$ mapM_C (cleanupTemp now)
@ -180,8 +181,7 @@ makeFoundation useEcho conf = do
case eres of case eres of
Left e -> $logError $ tshow e Left e -> $logError $ tshow e
Right () -> return () Right () -> return ()
liftIO $ threadDelay $ 30 * 60 * 1000000 liftIO $ threadDelay $ 30 * 60 * 1000000 -}
return foundation return foundation
cleanupTemp :: UTCTime -> FilePath -> ResourceT (LoggingT IO) () cleanupTemp :: UTCTime -> FilePath -> ResourceT (LoggingT IO) ()

1
Foundation.hs
View File

@ -87,6 +87,7 @@ instance Yesod App where
-- value passed to hamletToRepHtml cannot be a widget, this allows -- value passed to hamletToRepHtml cannot be a widget, this allows
-- you to use normal widget features in default-layout. -- you to use normal widget features in default-layout.
cur <- getCurrentRoute
pc <- widgetToPageContent $ do pc <- widgetToPageContent $ do
$(combineStylesheets 'StaticR $(combineStylesheets 'StaticR
[ css_normalize_css [ css_normalize_css

29
Handler/Snapshots.hs Normal file
View File

@ -0,0 +1,29 @@
{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Handler.Snapshots where
import Import
import qualified Database.Esqueleto as E
-- This is a handler function for the GET request method on the HomeR
-- resource pattern. All of your resource patterns are defined in
-- config/routes
--
-- The majority of the code you will write in Yesod lives in these handler
-- functions. You can spread them across multiple files if you are so
-- inclined, or create a single monolithic file.
getAllSnapshotsR :: Handler Html
getAllSnapshotsR = do
stackages <- runDB $ E.select $ E.from $ \(stackage `E.InnerJoin` user) -> do
E.on (stackage E.^. StackageUser E.==. user E.^. UserId)
E.orderBy [E.desc $ stackage E.^. StackageUploaded]
return
( stackage E.^. StackageIdent
, stackage E.^. StackageTitle
, stackage E.^. StackageUploaded
, user E.^. UserDisplay
, user E.^. UserHandle
)
defaultLayout $ do
setTitle "Stackage Server"
$(widgetFile "all-snapshots")

1
config/routes
View File

@ -5,6 +5,7 @@
/robots.txt RobotsR GET /robots.txt RobotsR GET
/ HomeR GET / HomeR GET
/snapshots AllSnapshotsR GET
/profile ProfileR GET PUT /profile ProfileR GET PUT
/email/#EmailId EmailR DELETE /email/#EmailId EmailR DELETE
/reset-token ResetTokenR POST /reset-token ResetTokenR POST

1
stackage-server.cabal
View File

@ -25,6 +25,7 @@ library
Data.Hackage.Views Data.Hackage.Views
Types Types
Handler.Home Handler.Home
Handler.Snapshots
Handler.Profile Handler.Profile
Handler.Email Handler.Email
Handler.ResetToken Handler.ResetToken

7
templates/all-snapshots.hamlet Normal file
View File

@ -0,0 +1,7 @@
<div .container>
<ul>
$forall (E.Value ident, E.Value title, E.Value uploaded, E.Value display, E.Value handle) <- stackages
<li>
<a href=@{StackageHomeR ident}>
#{title}
<i>by #{display} (#{handle}) on #{show uploaded}

7
templates/default-layout-wrapper.hamlet
View File

@ -26,10 +26,9 @@ $newline never
<script> <script>
document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/,'js'); document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/,'js');
<body> <body>
<div class="container"> <header>
<header> <div id="main" role="main">
<div id="main" role="main"> ^{pageBody pc}
^{pageBody pc}
\<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started --> \<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started -->
\<!--[if lt IE 7 ]> \<!--[if lt IE 7 ]>

48
templates/default-layout.hamlet
View File

@ -1,22 +1,34 @@
<nav .navbar .navbar-default role=navigation> <div .container>
<div .container> <div .navbar role=navigation>
<div .navbar-header> <div .navbar-inner>
<div .navbar-brand> <a .brand href=@{HomeR}>
<a href=@{HomeR}> Stackage
Stackage <ul .nav>
<ul .nav .navbar-nav>
<li>
<a href=@{HomeR}>Home
$maybe Entity _ user <- muser
<li>You are logged in as #{userDisplay user} (#{userHandle user}).
<li> <li>
<a href=@{ProfileR}>Edit profile <a href=@{AllSnapshotsR}>
All Snapshots
<li> <li>
<a href=@{AuthR LogoutR}>Logout <a href=@{UploadStackageR}>
$nothing Upload
<li> <ul .nav .pull-right>
<a href=@{AuthR LoginR}>Login $maybe Entity _ user <- muser
<li>
<a href=@{ProfileR}>
<span .user-handle>
#{userHandle user}
<li>
<a href=@{AuthR LogoutR}>Logout
$nothing
<li>
<a href=@{AuthR LoginR}>Login
$maybe msg <- mmsg $maybe msg <- mmsg
<div .alert .alter-info>#{msg} <div .container>
^{widget} <div .alert .alter-info>#{msg}
$case cur
$of Just (AuthR _)
<div .container>
^{widget}
$of _
^{widget}

0
templates/default-layout.julius Normal file
View File

17
templates/default-layout.lucius
View File

@ -1,3 +1,16 @@
.brand { .navbar .nav > li > a {
color: #0088cc
}
.navbar .navbar-inner {
border: 0;
background: inherit;
border-top-left-radius: 0;
border-top-right-radius: 0;
}
.navbar .user-handle {
max-width: 15em;
overflow: hidden;
white-space: nowrap;
display: inline-block;
text-overflow:ellipsis;
} }

22
templates/homepage.hamlet
View File

@ -1,12 +1,10 @@
<h2>Browse stackages <div .container>
<p>
<ul> Stackage is an infrastructure to create stable builds of complete package sets. Think “stable Hackage”.
$forall (E.Value ident, E.Value title, E.Value uploaded, E.Value display, E.Value handle) <- stackages <h2>Recommended Snapshots
<li> <ul>
<a href=@{StackageHomeR ident}> $forall (E.Value ident, E.Value title, E.Value uploaded, E.Value display, E.Value handle) <- stackages
#{title} <li>
<i>by #{display} (#{handle}) on #{show uploaded} <a href=@{StackageHomeR ident}>
#{title}
<h2>Upload <i>by #{display} (#{handle}) on #{show uploaded}
<a href=@{UploadStackageR}>Upload

71
templates/profile.hamlet
View File

@ -1,43 +1,44 @@
<h2>Email addresses <div .container>
$if length emails <= 1 <h2>Email addresses
$forall Entity _ email <- emails $if length emails <= 1
<p>#{emailEmail email} $forall Entity _ email <- emails
$else <p>#{emailEmail email}
<ul> $else
$forall Entity eid email <- emails <ul>
<li .email> $forall Entity eid email <- emails
#{emailEmail email} <li .email>
<form method=post action=@{EmailR eid}?_method=DELETE> #{emailEmail email}
<button .btn>Remove <form method=post action=@{EmailR eid}?_method=DELETE>
<button .btn>Remove
<p> <p>
<a href=@{AuthR LoginR}>Add another email address. <a href=@{AuthR LoginR}>Add another email address.
<h2>Profile <h2>Profile
<form method=post action=@{ProfileR}?_method=PUT enctype=#{enctype} role=form> <form method=post action=@{ProfileR}?_method=PUT enctype=#{enctype} role=form>
<div .form-group> <div .form-group>
^{userWidget} ^{userWidget}
<button .btn>Update <button .btn>Update
<h2>Aliases <h2>Aliases
<form method=post action=@{AliasesR}?_method=PUT> <form method=post action=@{AliasesR}?_method=PUT>
Format: alias name, package set ID Format: alias name, package set ID
<textarea #aliases name=aliases>#{unlines $ map aliasToText aliases} <textarea #aliases name=aliases>#{unlines $ map aliasToText aliases}
<button .btn>Update <button .btn>Update
$if not $ null aliases $if not $ null aliases
<dl> <dl>
$forall Entity _ alias <- aliases $forall Entity _ alias <- aliases
<dt>#{aliasName alias} <dt>#{aliasName alias}
<dd> <dd>
$with url <- AliasR (userHandle user) (aliasName alias) [] $with url <- AliasR (userHandle user) (aliasName alias) []
<a href=@{url}>@{url} <a href=@{url}>@{url}
<h2>Security token <h2>Security token
<p> <p>
Your security token is #{userToken user}. Your security token is #{userToken user}.
<form method=post action=@{ResetTokenR}> <form method=post action=@{ResetTokenR}>
<button>Reset token <button>Reset token

9
templates/upload-stackage.hamlet
View File

@ -1,4 +1,5 @@
<form method=post action=@{UploadStackageR}?_method=PUT enctype=multipart/form-data> <div .container>
Stackage file: <form method=post action=@{UploadStackageR}?_method=PUT enctype=multipart/form-data>
<input type=file name=#{fileKey}> Stackage file:
<button>Upload <input type=file name=#{fileKey}>
<button>Upload