nek0/eidolon
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

switched to bootstrap3

Browse source
This commit is contained in:
nek0 2015-10-19 08:32:47 +02:00
parent a024fa5dd9
commit 745775b4fc
29 changed files with 165 additions and 133 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
Foundation.hs
View file

@ -97,12 +97,12 @@ renderLayout widget = do
searchWidget <- widgetToPageContent $ [whamlet| searchWidget <- widgetToPageContent $ [whamlet|
<form action=@{SearchR} method=GET> <form action=@{SearchR} method=GET>
<input type="hidden" name="_hasdata"> <input type="hidden" name="_hasdata">
<div .required> <div .input-group .required>
<label for="hident2"> <input #hident2 .form-control type="text" autofocus="" required="" name="f1" placeholder="Search for ...">
<input #hident2 type="search" autofocus="" required="" name="f1"> <span .input-group-btn>
<script> <button .btn .btn-default type="submit">Go!
if (!('autofocus' in document.createElement('input'))) {document.getElementById('hident2').focus();} <script>
<input value="Search" type="submit"> if (!('autofocus' in document.createElement('input'))) {document.getElementById('hident2').focus();}
|] |]
wc <- widgetToPageContent widget wc <- widgetToPageContent widget
@ -119,7 +119,7 @@ renderLayout widget = do
$(combineStylesheets 'StaticR $(combineStylesheets 'StaticR
[ [
-- css_normalize_css -- css_normalize_css
css_bootstrap_css css_bootstrap_min_css
]) ])
$(widgetFile "default-layout") $(widgetFile "default-layout")

19
Handler/AdminAlbumSettings.hs
View file

@ -66,7 +66,9 @@ getAdminAlbumSettingsR albumId = do
Just album -> do Just album -> do
entities <- runDB $ selectList [UserId !=. albumOwner album] [Desc UserName] entities <- runDB $ selectList [UserId !=. albumOwner album] [Desc UserName]
let users = map (\u -> (userName $ entityVal u, entityKey u)) entities let users = map (\u -> (userName $ entityVal u, entityKey u)) entities
(adminAlbumSettingsWidget, enctype) <- generateFormPost $ adminAlbumSettingsForm album albumId users (adminAlbumSettingsWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $
adminAlbumSettingsForm album albumId users
formLayout $ do formLayout $ do
setTitle "Administration: Album settings" setTitle "Administration: Album settings"
$(widgetFile "adminAlbumSet") $(widgetFile "adminAlbumSet")
@ -87,7 +89,9 @@ postAdminAlbumSettingsR albumId = do
Just album -> do Just album -> do
entities <- runDB $ selectList [UserId !=. albumOwner album] [Desc UserName] entities <- runDB $ selectList [UserId !=. albumOwner album] [Desc UserName]
let users = map (\u -> (userName $ entityVal u, entityKey u)) entities let users = map (\u -> (userName $ entityVal u, entityKey u)) entities
((res, _), _) <- runFormPost $ adminAlbumSettingsForm album albumId users ((res, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $
adminAlbumSettingsForm album albumId users
case res of case res of
FormSuccess temp -> do FormSuccess temp -> do
width <- getThumbWidth $ Just $ L.tail $ fromMaybe "a" $ albumSamplePic temp width <- getThumbWidth $ Just $ L.tail $ fromMaybe "a" $ albumSamplePic temp
@ -110,14 +114,15 @@ postAdminAlbumSettingsR albumId = do
setMessage errorMsg setMessage errorMsg
redirect route redirect route
adminAlbumSettingsForm :: Album -> AlbumId -> [(Text, UserId)] -> Form Album adminAlbumSettingsForm :: Album -> AlbumId -> [(Text, UserId)] -> AForm Handler Album
adminAlbumSettingsForm album albumId users = renderDivs $ Album adminAlbumSettingsForm album albumId users = Album
<$> areq textField "Title" (Just $ albumTitle album) <$> areq textField (bfs ("Title" :: T.Text)) (Just $ albumTitle album)
<*> pure (albumOwner album) <*> pure (albumOwner album)
<*> areq (userField users) "This album shared with" (Just $ albumShares album) <*> areq (userField users) (bfs ("This album shared with" :: T.Text)) (Just $ albumShares album)
<*> pure (albumContent album) <*> pure (albumContent album)
<*> aopt (selectField media) "Sample picture" (Just $ albumSamplePic album) <*> aopt (selectField media) (bfs ("Sample picture" :: T.Text)) (Just $ albumSamplePic album)
<*> pure 230 <*> pure 230
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
where where
media = do media = do
entities <- runDB $ selectList [MediumAlbum ==. albumId] [Asc MediumTitle] entities <- runDB $ selectList [MediumAlbum ==. albumId] [Asc MediumTitle]

19
Handler/AdminMediumSettings.hs
View file

@ -44,7 +44,9 @@ getAdminMediumSettingsR mediumId = do
tempMedium <- runDB $ get mediumId tempMedium <- runDB $ get mediumId
case tempMedium of case tempMedium of
Just medium -> do Just medium -> do
(adminMediumSetWidget, enctype) <- generateFormPost $ adminMediumSetForm medium (adminMediumSetWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $
adminMediumSetForm medium
formLayout $ do formLayout $ do
setTitle "Administration: Medium Settings" setTitle "Administration: Medium Settings"
$(widgetFile "adminMediumSet") $(widgetFile "adminMediumSet")
@ -63,7 +65,9 @@ postAdminMediumSettingsR mediumId = do
tempMedium <- runDB $ get mediumId tempMedium <- runDB $ get mediumId
case tempMedium of case tempMedium of
Just medium -> do Just medium -> do
((res, _), _) <- runFormPost $ adminMediumSetForm medium ((res, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $
adminMediumSetForm medium
case res of case res of
FormSuccess temp -> do FormSuccess temp -> do
runDB $ update mediumId runDB $ update mediumId
@ -84,21 +88,22 @@ postAdminMediumSettingsR mediumId = do
setMessage errorMsg setMessage errorMsg
redirect route redirect route
adminMediumSetForm :: Medium -> Form Medium adminMediumSetForm :: Medium -> AForm Handler Medium
adminMediumSetForm medium = renderDivs $ Medium adminMediumSetForm medium = Medium
<$> areq textField "Title" (Just $ mediumTitle medium) <$> areq textField (bfs ("Title" :: T.Text)) (Just $ mediumTitle medium)
<*> pure (mediumPath medium) <*> pure (mediumPath medium)
<*> pure (mediumThumb medium) <*> pure (mediumThumb medium)
<*> pure (mediumMime medium) <*> pure (mediumMime medium)
<*> pure (mediumTime medium) <*> pure (mediumTime medium)
<*> pure (mediumOwner medium) <*> pure (mediumOwner medium)
<*> aopt textareaField "Description" (Just $ mediumDescription medium) <*> aopt textareaField (bfs ("Description" :: T.Text)) (Just $ mediumDescription medium)
<*> areq tagField "Tags" (Just $ mediumTags medium) <*> areq tagField (bfs ("Tags" :: T.Text)) (Just $ mediumTags medium)
<*> pure (mediumWidth medium) <*> pure (mediumWidth medium)
<*> pure (mediumThumbWidth medium) <*> pure (mediumThumbWidth medium)
<*> pure (mediumAlbum medium) <*> pure (mediumAlbum medium)
<*> pure (mediumPreview medium) <*> pure (mediumPreview medium)
<*> pure (mediumPreviewWidth medium) <*> pure (mediumPreviewWidth medium)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
getAdminMediumDeleteR :: MediumId -> Handler Html getAdminMediumDeleteR :: MediumId -> Handler Html
getAdminMediumDeleteR mediumId = do getAdminMediumDeleteR mediumId = do

21
Handler/AdminProfileSettings.hs
View file

@ -85,7 +85,9 @@ getAdminProfileSettingsR ownerId = do
Just owner -> do Just owner -> do
tempUserId <- lookupSession "userId" tempUserId <- lookupSession "userId"
let userId = getUserIdFromText $ fromJust tempUserId let userId = getUserIdFromText $ fromJust tempUserId
(adminProfileSetWidget, enctype) <- generateFormPost $ adminProfileForm owner (adminProfileSetWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $
adminProfileForm owner
formLayout $ do formLayout $ do
setTitle "Administration: Profile settings" setTitle "Administration: Profile settings"
$(widgetFile "adminProfileSettings") $(widgetFile "adminProfileSettings")
@ -104,7 +106,9 @@ postAdminProfileSettingsR ownerId = do
tempOwner <- runDB $ get ownerId tempOwner <- runDB $ get ownerId
case tempOwner of case tempOwner of
Just owner -> do Just owner -> do
((result, _), _) <- runFormPost $ adminProfileForm owner ((result, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $
adminProfileForm owner
case result of case result of
FormSuccess temp -> do FormSuccess temp -> do
runDB $ update ownerId runDB $ update ownerId
@ -127,15 +131,16 @@ postAdminProfileSettingsR ownerId = do
redirect route redirect route
adminProfileForm :: User -> Form User adminProfileForm :: User -> AForm Handler User
adminProfileForm owner = renderDivs $ User adminProfileForm owner = User
<$> areq textField "Username" (Just $ userName owner) <$> areq textField (bfs ("Username" :: T.Text)) (Just $ userName owner)
<*> areq textField "Userslug" (Just $ userSlug owner) <*> areq textField (bfs ("Userslug" :: T.Text)) (Just $ userSlug owner)
<*> areq emailField "Email" (Just $ userEmail owner) <*> areq emailField (bfs ("Email" :: T.Text)) (Just $ userEmail owner)
<*> pure (userSalt owner) <*> pure (userSalt owner)
<*> pure (userSalted owner) <*> pure (userSalted owner)
<*> pure (userAlbums owner) <*> pure (userAlbums owner)
<*> areq boolField "Admin" (Just $ userAdmin owner) <*> areq boolField (bfs ("Admin" :: T.Text)) (Just $ userAdmin owner)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text)
getAdminProfileDeleteR :: UserId -> Handler Html getAdminProfileDeleteR :: UserId -> Handler Html
getAdminProfileDeleteR ownerId = do getAdminProfileDeleteR ownerId = do

22
Handler/AlbumSettings.hs
View file

@ -40,7 +40,9 @@ getAlbumSettingsR albumId = do
True -> do True -> do
entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName] entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName]
let users = map (\u -> (userName $ entityVal u, entityKey u)) entities let users = map (\u -> (userName $ entityVal u, entityKey u)) entities
(albumSettingsWidget, enctype) <- generateFormPost $ albumSettingsForm album albumId users (albumSettingsWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $
albumSettingsForm album albumId users
formLayout $ do formLayout $ do
setTitle "Eidolon :: Album Settings" setTitle "Eidolon :: Album Settings"
$(widgetFile "albumSettings") $(widgetFile "albumSettings")
@ -73,7 +75,9 @@ postAlbumSettingsR albumId = do
then do then do
entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName] entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName]
let users = map (\u -> (userName $ entityVal u, entityKey u)) entities let users = map (\u -> (userName $ entityVal u, entityKey u)) entities
((result, _), _) <- runFormPost $ albumSettingsForm album albumId users ((result, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $
albumSettingsForm album albumId users
case result of case result of
FormSuccess temp -> do FormSuccess temp -> do
let newShares = L.sort $ albumShares temp let newShares = L.sort $ albumShares temp
@ -127,21 +131,19 @@ postAlbumSettingsR albumId = do
setMessage "This album does not exist" setMessage "This album does not exist"
redirect HomeR redirect HomeR
albumSettingsForm :: Album -> AlbumId -> [(Text, UserId)]-> Form Album albumSettingsForm :: Album -> AlbumId -> [(Text, UserId)]-> AForm Handler Album
albumSettingsForm album albumId users = renderDivs $ Album albumSettingsForm album albumId users = Album
<$> areq textField "Title" (Just $ albumTitle album) <$> areq textField (bfs ("Title" :: T.Text)) (Just $ albumTitle album)
<*> pure (albumOwner album) <*> pure (albumOwner album)
<*> areq (userField users) "Share this album with" (Just $ albumShares album) <*> areq (userField users) (bfs ("Share this album with" :: T.Text)) (Just $ albumShares album)
<*> pure (albumContent album) <*> pure (albumContent album)
<*> aopt (selectField media) "Sample picture" (Just $ albumSamplePic album) <*> aopt (selectField media) (bfs ("Sample picture" :: T.Text)) (Just $ albumSamplePic album)
<*> pure 230 <*> pure 230
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
where where
media = do media = do
entities <- runDB $ selectList [MediumAlbum ==. albumId] [Asc MediumTitle] entities <- runDB $ selectList [MediumAlbum ==. albumId] [Asc MediumTitle]
optionsPairs $ map (\med -> (mediumTitle $ entityVal med, mediumThumb (entityVal med))) entities optionsPairs $ map (\med -> (mediumTitle $ entityVal med, mediumThumb (entityVal med))) entities
-- users = do
-- entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName]
-- return $ map (\u -> (userName $ entityVal u, entityKey u)) entities
getAlbumDeleteR :: AlbumId -> Handler Html getAlbumDeleteR :: AlbumId -> Handler Html
getAlbumDeleteR albumId = do getAlbumDeleteR albumId = do

23
Handler/Medium.hs
View file

@ -50,7 +50,9 @@ getMediumR mediumId = do
Nothing -> Nothing ->
return Nothing return Nothing
let presence = userId == (Just ownerId) || userId == Just (albumOwner album) let presence = userId == (Just ownerId) || userId == Just (albumOwner album)
(commentWidget, enctype) <- generateFormPost $ commentForm (fromJust userId) (fromJust userSl) mediumId Nothing (commentWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $
commentForm (fromJust userId) (fromJust userSl) mediumId Nothing
comments <- runDB $ selectList comments <- runDB $ selectList
[ CommentOrigin ==. mediumId [ CommentOrigin ==. mediumId
, CommentParent ==. Nothing ] , CommentParent ==. Nothing ]
@ -83,7 +85,9 @@ postMediumR mediumId = do
let userId = getUserIdFromText tempUserId let userId = getUserIdFromText tempUserId
u <- runDB $ getJust userId u <- runDB $ getJust userId
let userSl = userSlug u let userSl = userSlug u
((res, _), _) <- runFormPost $ commentForm userId userSl mediumId Nothing ((res, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $
commentForm userId userSl mediumId Nothing
case res of case res of
FormSuccess temp -> do FormSuccess temp -> do
cId <- runDB $ insert temp cId <- runDB $ insert temp
@ -113,14 +117,15 @@ postMediumR mediumId = do
setMessage "This image does not exist" setMessage "This image does not exist"
redirect HomeR redirect HomeR
commentForm :: UserId -> Text -> MediumId -> Maybe CommentId -> Form Comment commentForm :: UserId -> Text -> MediumId -> Maybe CommentId -> AForm Handler Comment
commentForm authorId authorSlug originId parentId = renderDivs $ Comment commentForm authorId authorSlug originId parentId = Comment
<$> pure authorId <$> pure authorId
<*> pure authorSlug <*> pure authorSlug
<*> pure originId <*> pure originId
<*> pure parentId <*> pure parentId
<*> lift (liftIO getCurrentTime) <*> lift (liftIO getCurrentTime)
<*> areq markdownField "Comment this medium" Nothing <*> areq markdownField (bfs ("Comment this medium" :: T.Text)) Nothing
<* bootstrapSubmit ("Post comment" :: BootstrapSubmit Text)
getCommentReplyR :: CommentId -> Handler Html getCommentReplyR :: CommentId -> Handler Html
getCommentReplyR commentId = do getCommentReplyR commentId = do
@ -134,7 +139,9 @@ getCommentReplyR commentId = do
u <- runDB $ getJust userId u <- runDB $ getJust userId
let userSl = userSlug u let userSl = userSlug u
let mediumId = commentOrigin comment let mediumId = commentOrigin comment
(replyWidget, enctype) <- generateFormPost $ commentForm userId userSl mediumId (Just commentId) (replyWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $
commentForm userId userSl mediumId (Just commentId)
formLayout $ do formLayout $ do
setTitle "Eidolon :: Reply to comment" setTitle "Eidolon :: Reply to comment"
$(widgetFile "commentReply") $(widgetFile "commentReply")
@ -157,7 +164,9 @@ postCommentReplyR commentId = do
u <- runDB $ getJust userId u <- runDB $ getJust userId
let userSl = userSlug u let userSl = userSlug u
let mediumId = commentOrigin comment let mediumId = commentOrigin comment
((res, _), _) <- runFormPost $ commentForm userId userSl mediumId (Just commentId) ((res, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $
commentForm userId userSl mediumId (Just commentId)
case res of case res of
FormSuccess temp -> do FormSuccess temp -> do
cId <- runDB $ insert temp cId <- runDB $ insert temp

19
Handler/MediumSettings.hs
View file

@ -28,7 +28,9 @@ getMediumSettingsR mediumId = do
checkRes <- mediumCheck mediumId checkRes <- mediumCheck mediumId
case checkRes of case checkRes of
Right medium -> do Right medium -> do
(mediumSettingsWidget, enctype) <- generateFormPost $ mediumSettingsForm medium (mediumSettingsWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $
mediumSettingsForm medium
formLayout $ do formLayout $ do
setTitle "Eidolon :: Medium Settings" setTitle "Eidolon :: Medium Settings"
$(widgetFile "mediumSettings") $(widgetFile "mediumSettings")
@ -41,7 +43,9 @@ postMediumSettingsR mediumId = do
checkRes <- mediumCheck mediumId checkRes <- mediumCheck mediumId
case checkRes of case checkRes of
Right medium -> do Right medium -> do
((result, _), _) <- runFormPost $ mediumSettingsForm medium ((result, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $
mediumSettingsForm medium
case result of case result of
FormSuccess temp -> do FormSuccess temp -> do
_ <- runDB $ update mediumId _ <- runDB $ update mediumId
@ -59,21 +63,22 @@ postMediumSettingsR mediumId = do
setMessage errorMsg setMessage errorMsg
redirect route redirect route
mediumSettingsForm :: Medium -> Form Medium mediumSettingsForm :: Medium -> AForm Handler Medium
mediumSettingsForm medium = renderDivs $ Medium mediumSettingsForm medium = Medium
<$> areq textField "Title" (Just $ mediumTitle medium) <$> areq textField (bfs ("Title" :: T.Text)) (Just $ mediumTitle medium)
<*> pure (mediumPath medium) <*> pure (mediumPath medium)
<*> pure (mediumThumb medium) <*> pure (mediumThumb medium)
<*> pure (mediumMime medium) <*> pure (mediumMime medium)
<*> pure (mediumTime medium) <*> pure (mediumTime medium)
<*> pure (mediumOwner medium) <*> pure (mediumOwner medium)
<*> aopt textareaField "Description" (Just $ mediumDescription medium) <*> aopt textareaField (bfs ("Description" :: T.Text)) (Just $ mediumDescription medium)
<*> areq tagField "tags" (Just $ mediumTags medium) <*> areq tagField (bfs ("tags" :: T.Text)) (Just $ mediumTags medium)
<*> pure (mediumWidth medium) <*> pure (mediumWidth medium)
<*> pure (mediumThumbWidth medium) <*> pure (mediumThumbWidth medium)
<*> pure (mediumAlbum medium) <*> pure (mediumAlbum medium)
<*> pure (mediumPreview medium) <*> pure (mediumPreview medium)
<*> pure (mediumPreviewWidth medium) <*> pure (mediumPreviewWidth medium)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text)
getMediumDeleteR :: MediumId -> Handler Html getMediumDeleteR :: MediumId -> Handler Html
getMediumDeleteR mediumId = do getMediumDeleteR mediumId = do

17
Handler/NewAlbum.hs
View file

@ -18,7 +18,7 @@ module Handler.NewAlbum where
import Import import Import
import Handler.Commons import Handler.Commons
import Data.Text import Data.Text as T
import System.Directory import System.Directory
import System.FilePath import System.FilePath
@ -28,7 +28,9 @@ getNewAlbumR = do
case msu of case msu of
Just tempUserId -> do Just tempUserId -> do
userId <- lift $ pure $ getUserIdFromText tempUserId userId <- lift $ pure $ getUserIdFromText tempUserId
(albumWidget, enctype) <- generateFormPost (albumForm userId) (albumWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $
albumForm userId
formLayout $ do formLayout $ do
setTitle "Eidolon :: Create new Album" setTitle "Eidolon :: Create new Album"
$(widgetFile "newAlbum") $(widgetFile "newAlbum")
@ -42,7 +44,9 @@ postNewAlbumR = do
case msu of case msu of
Just tempUserId -> do Just tempUserId -> do
let userId = getUserIdFromText tempUserId let userId = getUserIdFromText tempUserId
((result, _), _) <- runFormPost (albumForm userId) ((result, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $
albumForm userId
case result of case result of
FormSuccess album -> do FormSuccess album -> do
-- Put album in Database -- Put album in Database
@ -66,11 +70,12 @@ postNewAlbumR = do
setMessage "You must be logged in to create albums" setMessage "You must be logged in to create albums"
redirect LoginR redirect LoginR
albumForm :: UserId -> Form Album albumForm :: UserId -> AForm Handler Album
albumForm userId = renderDivs $ Album albumForm userId = Album
<$> areq textField "Title" Nothing <$> areq textField (bfs ("Title" :: T.Text)) Nothing
<*> pure userId <*> pure userId
<*> pure [] <*> pure []
<*> pure [] <*> pure []
<*> pure Nothing <*> pure Nothing
<*> pure 230 <*> pure 230
<* bootstrapSubmit ("Create album" :: BootstrapSubmit Text)

18
Handler/ProfileSettings.hs
View file

@ -17,6 +17,7 @@
module Handler.ProfileSettings where module Handler.ProfileSettings where
import Import import Import
import qualified Data.Text as T
import Handler.Commons import Handler.Commons
getProfileSettingsR :: UserId -> Handler Html getProfileSettingsR :: UserId -> Handler Html
@ -24,7 +25,8 @@ getProfileSettingsR userId = do
checkRes <- profileCheck userId checkRes <- profileCheck userId
case checkRes of case checkRes of
Right user -> do Right user -> do
(profileSettingsWidget, enctype) <- generateFormPost $ profileSettingsForm user (profileSettingsWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $ profileSettingsForm user
formLayout $ do formLayout $ do
setTitle "Eidolon :: Profile settings" setTitle "Eidolon :: Profile settings"
$(widgetFile "profileSettings") $(widgetFile "profileSettings")
@ -37,7 +39,8 @@ postProfileSettingsR userId = do
checkRes <- profileCheck userId checkRes <- profileCheck userId
case checkRes of case checkRes of
Right user -> do Right user -> do
((result, _), _) <- runFormPost $ profileSettingsForm user ((result, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm$ profileSettingsForm user
case result of case result of
FormSuccess temp -> do FormSuccess temp -> do
runDB $ update userId [ runDB $ update userId [
@ -56,12 +59,13 @@ postProfileSettingsR userId = do
redirect route redirect route
profileSettingsForm :: User -> Form User profileSettingsForm :: User -> AForm Handler User
profileSettingsForm user = renderDivs $ User profileSettingsForm user = User
<$> areq textField "Username" (Just $ userName user) <$> areq textField (bfs ("Username" :: T.Text)) (Just $ userName user)
<*> areq textField "Userslug" (Just $ userSlug user) <*> areq textField (bfs ("Userslug" :: T.Text)) (Just $ userSlug user)
<*> areq emailField "Email" (Just $ userEmail user) <*> areq emailField (bfs ("Email" :: T.Text)) (Just $ userEmail user)
<*> pure (userSalt user) <*> pure (userSalt user)
<*> pure (userSalted user) <*> pure (userSalted user)
<*> pure (userAlbums user) <*> pure (userAlbums user)
<*> pure (userAdmin user) <*> pure (userAdmin user)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)

36
Handler/Upload.hs
View file

@ -41,7 +41,7 @@ getDirectUploadR albumId = do
userId == ownerId || userId `elem` albumShares album userId == ownerId || userId `elem` albumShares album
-- is the owner present or a user with whom the album is shared -- is the owner present or a user with whom the album is shared
then do then do
(dUploadWidget, enctype) <- generateFormPost $ dUploadForm userId albumId (dUploadWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId albumId
formLayout $ do formLayout $ do
setTitle $ toHtml ("Eidolon :: Upload medium to " `T.append` albumTitle album) setTitle $ toHtml ("Eidolon :: Upload medium to " `T.append` albumTitle album)
$(widgetFile "dUpload") $(widgetFile "dUpload")
@ -65,11 +65,10 @@ postDirectUploadR albumId = do
case msu of -- is anybody logged in case msu of -- is anybody logged in
Just tempUserId -> do Just tempUserId -> do
let userId = getUserIdFromText tempUserId let userId = getUserIdFromText tempUserId
if if userId == ownerId || userId `elem` albumShares album
userId == ownerId || userId `elem` albumShares album
-- is the logged in user the owner or is the album shared with him -- is the logged in user the owner or is the album shared with him
then do then do
((result, _), _) <- runFormPost (dUploadForm userId albumId) ((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId albumId
case result of case result of
FormSuccess temp -> do FormSuccess temp -> do
let fils = fileBulkFiles temp let fils = fileBulkFiles temp
@ -160,15 +159,17 @@ writeOnDrive fil userId albumId = do
liftIO $ fileMove fil path liftIO $ fileMove fil path
return path return path
dUploadForm :: UserId -> AlbumId -> Form FileBulk dUploadForm :: UserId -> AlbumId -> AForm Handler FileBulk
dUploadForm userId albumId = renderDivs $ FileBulk dUploadForm userId albumId = FileBulk
<$> areq textField "Title" Nothing <$> areq textField (bfs ("Title" :: T.Text)) Nothing
<*> areq multiFileField "Select file(s)" Nothing <*> areq multiFileField "Select file(s)" Nothing
<*> lift (liftIO getCurrentTime) <*> lift (liftIO getCurrentTime)
<*> pure userId <*> pure userId
<*> aopt textareaField "Description" Nothing <*> aopt textareaField (bfs ("Description" :: T.Text)) Nothing
<*> areq tagField "Enter tags" Nothing <*> areq tagField (bfs ("Enter tags" :: T.Text)) Nothing
<*> pure albumId <*> pure albumId
<* bootstrapSubmit ("Upload" :: BootstrapSubmit Text)
data FileBulk = FileBulk data FileBulk = FileBulk
{ fileBulkPrefix :: Text { fileBulkPrefix :: Text
@ -194,7 +195,7 @@ getUploadR = do
setMessage "Please create an album first" setMessage "Please create an album first"
redirect NewAlbumR redirect NewAlbumR
else do else do
(uploadWidget, enctype) <- generateFormPost (bulkUploadForm userId) (uploadWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm $ bulkUploadForm userId
formLayout $ do formLayout $ do
setTitle "Eidolon :: Upload Medium" setTitle "Eidolon :: Upload Medium"
$(widgetFile "bulkUpload") $(widgetFile "bulkUpload")
@ -202,15 +203,16 @@ getUploadR = do
setMessage "You need to be logged in" setMessage "You need to be logged in"
redirect LoginR redirect LoginR
bulkUploadForm :: UserId -> Form FileBulk bulkUploadForm :: UserId -> AForm Handler FileBulk
bulkUploadForm userId = renderDivs $ (\a b c d e f g -> FileBulk b c d e f g a) bulkUploadForm userId = (\a b c d e f g -> FileBulk b c d e f g a)
<$> areq (selectField albums) "Album" Nothing <$> areq (selectField albums) (bfs ("Album" :: T.Text)) Nothing
<*> areq textField "Title" Nothing <*> areq textField (bfs ("Title" :: T.Text)) Nothing
<*> areq multiFileField "Select file(s)" Nothing <*> areq multiFileField "Select file(s)" Nothing
<*> lift (liftIO getCurrentTime) <*> lift (liftIO getCurrentTime)
<*> pure userId <*> pure userId
<*> aopt textareaField "Description" Nothing <*> aopt textareaField (bfs ("Description" :: T.Text)) Nothing
<*> areq tagField "Enter tags" Nothing <*> areq tagField (bfs ("Enter tags" :: T.Text)) Nothing
<* bootstrapSubmit ("Upload" :: BootstrapSubmit Text)
where where
albums = do albums = do
allEnts <- runDB $ selectList [] [Desc AlbumTitle] allEnts <- runDB $ selectList [] [Desc AlbumTitle]
@ -228,7 +230,7 @@ postUploadR = do
case msu of case msu of
Just tempUserId -> do Just tempUserId -> do
let userId = getUserIdFromText tempUserId let userId = getUserIdFromText tempUserId
((result, _), _) <- runFormPost (bulkUploadForm userId) ((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ bulkUploadForm userId
case result of case result of
FormSuccess temp -> do FormSuccess temp -> do
let fils = fileBulkFiles temp let fils = fileBulkFiles temp

8
Helper.hs
View file

@ -100,8 +100,8 @@ tagField = Field
False -> return $ Right $ Just $ removeItem "" $ T.splitOn " " x False -> return $ Right $ Just $ removeItem "" $ T.splitOn " " x
True -> return $ Right $ Nothing True -> return $ Right $ Nothing
_ -> return $ Left $ error "unexpected tag list" _ -> return $ Left $ error "unexpected tag list"
, fieldView = \idAttr nameAttr _ eResult _ -> , fieldView = \idAttr nameAttr attrs eResult _ ->
[whamlet|<input id=#{idAttr} type="text" name=#{nameAttr} value=#{either id (T.intercalate " ") eResult}>|] [whamlet|<input id=#{idAttr} type="text" name=#{nameAttr} *{attrs} value=#{either id (T.intercalate " ") eResult}>|]
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
@ -118,8 +118,8 @@ userField users = Field
True -> return $ Left $ error "Invalid username list" True -> return $ Left $ error "Invalid username list"
True -> return $ Right $ Just $ [] True -> return $ Right $ Just $ []
_ -> return $ Left $ error "unexpected username list" _ -> return $ Left $ error "unexpected username list"
, fieldView = \idAttr nameAttr _ eResult _ -> , fieldView = \idAttr nameAttr attrs eResult _ ->
[whamlet|<input id=#{idAttr} type="text" name=#{nameAttr} value=#{either id (getUsersFromResult users) eResult}>|] [whamlet|<input id=#{idAttr} type="text" name=#{nameAttr} *{attrs} value=#{either id (getUsersFromResult users) eResult}>|]
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }

1
Import.hs
View file

@ -22,6 +22,7 @@ import Prelude as Import hiding (head, init, last,
readFile, tail, writeFile) readFile, tail, writeFile)
import Yesod as Import hiding (Route (..)) import Yesod as Import hiding (Route (..))
import Yesod.Static as Import import Yesod.Static as Import
import Yesod.Form.Bootstrap3 as Import
import Data.Text as Import (Text) import Data.Text as Import (Text)

1
eidolon.cabal
View file

@ -126,6 +126,7 @@ library
, system-filepath , system-filepath
, bytestring , bytestring
, http-client , http-client
, yesod-form
executable eidolon executable eidolon
if flag(library-only) if flag(library-only)

1
static/css/bootstrap.css.map Normal file
View file

File diff suppressed because one or more lines are too long

5
static/css/bootstrap.min.css vendored Normal file
View file

File diff suppressed because one or more lines are too long

2
templates/adminAlbumSet.hamlet
View file

@ -3,8 +3,6 @@ $newline always
<form class="inner" method="post" enctype=#{enctype}> <form class="inner" method="post" enctype=#{enctype}>
<h1>Album settings <h1>Album settings
^{adminAlbumSettingsWidget} ^{adminAlbumSettingsWidget}
<div>
<input type=submit value="Change settings">
<a href=@{AdminAlbumDeleteR albumId}>Delete this album <a href=@{AdminAlbumDeleteR albumId}>Delete this album

2
templates/adminMediumSet.hamlet
View file

@ -3,7 +3,5 @@ $newline always
<form class="inner" method="post" enctype=#{enctype}> <form class="inner" method="post" enctype=#{enctype}>
<h1>Medium settings <h1>Medium settings
^{adminMediumSetWidget} ^{adminMediumSetWidget}
<div>
<input type=submit value="Change settings">
<a href=@{AdminMediumDeleteR mediumId}>Delete this medium <a href=@{AdminMediumDeleteR mediumId}>Delete this medium

2
templates/adminProfileSettings.hamlet
View file

@ -3,8 +3,6 @@ $newline always
<form class="inner" method="post" enctype=#{enctype}> <form class="inner" method="post" enctype=#{enctype}>
<h1>Profile Settings <h1>Profile Settings
^{adminProfileSetWidget} ^{adminProfileSetWidget}
<div>
<input type=submit value="Change settings">
<a href=@{AdminProfileDeleteR userId}>Delete user <a href=@{AdminProfileDeleteR userId}>Delete user

6
templates/albumSettings.hamlet
View file

@ -3,7 +3,5 @@ $newline always
<form class="inner" method="post" enctype=#{enctype}> <form class="inner" method="post" enctype=#{enctype}>
<h3>Album settings <h3>Album settings
^{albumSettingsWidget} ^{albumSettingsWidget}
<div> $if ownerPresence == True
<input type=submit value="Change settings"> <a href=@{AlbumDeleteR albumId}>Delete this album
$if ownerPresence == True
<a href=@{AlbumDeleteR albumId}>Delete this album

2
templates/bulkUpload.hamlet
View file

@ -3,5 +3,3 @@
<h3>Upload multiple images <h3>Upload multiple images
<p>Here you can upload your images. <p>Here you can upload your images.
^{uploadWidget} ^{uploadWidget}
<div>
<input type=submit value="Upload">

2
templates/commentReply.hamlet
View file

@ -7,5 +7,3 @@
<hr> <hr>
<form method=post enctype=#{enctype}> <form method=post enctype=#{enctype}>
^{replyWidget} ^{replyWidget}
<div>
<input type=submit value="Post reply">

2
templates/dUpload.hamlet
View file

@ -3,5 +3,3 @@
<h1>Image upload to album #{albumTitle album} <h1>Image upload to album #{albumTitle album}
<p>Here you can upload your image. <p>Here you can upload your image.
^{dUploadWidget} ^{dUploadWidget}
<div>
<input type=submit value="Upload">

15
templates/login.hamlet
View file

@ -2,16 +2,17 @@ $newline always
<div id="header" class="item" data-width="300"> <div id="header" class="item" data-width="300">
<noscript>Please enable Javascript <noscript>Please enable Javascript
<h3>Login
<form class="inner r"> <form class="inner r">
<h3>Login <div .form-group .required>
<p>
<label for="username">User: <label for="username">User:
<input id="username" type="text" required> <input .form-control #username type="text" required>
<p> <div .form-group .required>
<label for="password">Password: <label for="password">Password:
<input id="password" type="password" required> <input .form-control #password type="password" required>
<p id="progress"> <div .form-group .optional>
<input id="login" type="submit" value="Login"> <button .btn .btn-default #login type="submit">Login
<div #progress>
<a href=@{ReactivateR}>Forgot your Password? <a href=@{ReactivateR}>Forgot your Password?

2
templates/medium.hamlet
View file

@ -65,8 +65,6 @@ $if userId /= Nothing
<div class="inner"> <div class="inner">
<form method=post enctype=#{enctype}> <form method=post enctype=#{enctype}>
^{commentWidget} ^{commentWidget}
<div>
<input type=submit value="Post comment">
<style type="text/css"> <style type="text/css">
body{background-image: url('/static/css/images/overlay.png'), -webkit-linear-gradient(top, rgba(0,0,0,0) 75%, rgba(0,0,0,0.65)), url('@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []}');background-attachment:fixed;background-image: url('/static/css/images/overlay.png'), -moz-linear-gradient(center top , transparent 75%, rgba(0, 0, 0, 0.65)), url('@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []}');} body{background-image: url('/static/css/images/overlay.png'), -webkit-linear-gradient(top, rgba(0,0,0,0) 75%, rgba(0,0,0,0.65)), url('@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []}');background-attachment:fixed;background-image: url('/static/css/images/overlay.png'), -moz-linear-gradient(center top , transparent 75%, rgba(0, 0, 0, 0.65)), url('@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []}');}

8
templates/mediumDelete.hamlet
View file

@ -7,9 +7,11 @@ $newline always
Do you wish to delete this image? Do you wish to delete this image?
<form method="POST" action=@{MediumDeleteR mediumId}> <form method="POST" action=@{MediumDeleteR mediumId}>
<label for="confirm">Really delete this medium <div .form-group .required>
<input type="checkbox" id="confirm" name="confirm" value="confirm" required> <label for="confirm">Really delete this medium
<input id="delete" type="submit" value="Delete medium"> <input .form-control type="checkbox" #confirm name="confirm" value="confirm" required>
<div .form-group .required>
<button .form-control id="delete" type="submit">Delete medium
<style type="text/css"> <style type="text/css">
body{background-image: url('/static/css/images/overlay.png'), -webkit-linear-gradient(top, rgba(0,0,0,0) 75%, rgba(0,0,0,0.65)), url('@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []}');background-attachment:fixed;background-image: url('/static/css/images/images/overlay.png'), -moz-linear-gradient(center top , transparent 75%, rgba(0, 0, 0, 0.65)), url('@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []}');} body{background-image: url('/static/css/images/overlay.png'), -webkit-linear-gradient(top, rgba(0,0,0,0) 75%, rgba(0,0,0,0.65)), url('@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []}');background-attachment:fixed;background-image: url('/static/css/images/images/overlay.png'), -moz-linear-gradient(center top , transparent 75%, rgba(0, 0, 0, 0.65)), url('@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []}');}

2
templates/mediumSettings.hamlet
View file

@ -5,8 +5,6 @@ $newline always
<form method="post" enctype=#{enctype}> <form method="post" enctype=#{enctype}>
^{mediumSettingsWidget} ^{mediumSettingsWidget}
<div>
<input type=submit value="Change settings">
<a href=@{MediumDeleteR mediumId}>Delete this image <a href=@{MediumDeleteR mediumId}>Delete this image

4
templates/newAlbum.hamlet
View file

@ -1,7 +1,5 @@
<div id="header" class="item" data-width="300"> <div id="header" class="item" data-width="300">
<h3>Create new Album
<form class="inner r" method=post enctype=#{enctype}> <form class="inner r" method=post enctype=#{enctype}>
<h3>Create new Album
^{albumWidget} ^{albumWidget}
<div>
<input type=submit value="Create">

2
templates/profileSettings.hamlet
View file

@ -3,7 +3,5 @@ $newline always
<form class="inner" method="post" enctype=#{enctype}> <form class="inner" method="post" enctype=#{enctype}>
<h3>Profile settings <h3>Profile settings
^{profileSettingsWidget} ^{profileSettingsWidget}
<div>
<input type=submit value="Change settings">
<a href=@{ProfileDeleteR userId}>Delete user <a href=@{ProfileDeleteR userId}>Delete user

23
templates/signup.hamlet
View file

@ -1,20 +1,21 @@
$newline always $newline always
<div id="header" class="item" data-width="300"> <div id="header" class="item" data-width="300">
<noscript>You need to have Javscript enabled <noscript>You need to have Javscript enabled
<form class="inner" method="POST" action="/signup"> <h3>Signup
<h3>Signup <form role="form" class="inner" method="POST" action=@{SignupR}>
<p> <div .form-group .required>
<label for="username">Username: <label for="username">Username:
<input id="username" name="username" type="text" required> <input .form-control #username name="username" type="text" required>
<p> <div .form-group .required>
<label for="email">E-Mail: <label for="email">E-Mail:
<input id="email" name="email" type="email" required> <input .form-control #email name="email" type="email" required>
<p class="tos"> <div .form-group .required>
<input type="checkbox" id="tos-1" name="tos-1" value="tos-1" required> <input .form-control type="checkbox" #tos-1 name="tos-1" value="tos-1" required>
<label for="tos-1">#{appTos1 $ appSettings master} <label for="tos-1">#{appTos1 $ appSettings master}
<p class="tos"> <div .form-group .required>
<input type="checkbox" id="tos-2" name="tos-2" value="tos-2" required> <input .form-control type="checkbox" #tos-2 name="tos-2" value="tos-2" required>
<label for="tos-2">#{appTos2 $ appSettings master} <label for="tos-2">#{appTos2 $ appSettings master}
<input id="signup" type="submit" value="Signup"> <div .form-group .optional>
<button .btn .btn-default #signup type="submit">Signup
<script src="/static/js/jquery.min.js" type="text/javascript"> <script src="/static/js/jquery.min.js" type="text/javascript">
<script src="/static/js/signup.js" type="text/javascript"> <script src="/static/js/signup.js" type="text/javascript">