haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-02-20 23:05:47 +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}

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

@ -26,7 +26,6 @@ $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}

28
templates/default-layout.hamlet
View File

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

10
templates/homepage.hamlet
View File

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

1
templates/profile.hamlet
View File

@ -1,3 +1,4 @@
<div .container>
<h2>Email addresses <h2>Email addresses
$if length emails <= 1 $if length emails <= 1
$forall Entity _ email <- emails $forall Entity _ email <- emails

1
templates/upload-stackage.hamlet
View File

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