removing remnants
This commit is contained in:
parent
d25152b8ab
commit
ee65575a0f
12 changed files with 13 additions and 126 deletions
|
@ -97,7 +97,7 @@ postActivateR token = do
|
|||
_ ->
|
||||
returnJsonError "Invalid activation token!"
|
||||
|
||||
returnJson :: (Monad m, ToJSON a, a ~ Value) =>
|
||||
returnJson :: (Monad m, a ~ Value) =>
|
||||
[(Text, a)] -> m RepJson
|
||||
returnJson = return . repJson . object
|
||||
|
||||
|
|
|
@ -94,12 +94,10 @@ postAdminAlbumSettingsR albumId = do
|
|||
adminAlbumSettingsForm album albumId users
|
||||
case res of
|
||||
FormSuccess temp -> do
|
||||
width <- getThumbWidth $ albumSamplePic temp
|
||||
_ <- runDB $ update albumId
|
||||
[ AlbumTitle =. albumTitle temp
|
||||
, AlbumShares =. albumShares temp
|
||||
, AlbumSamplePic =. albumSamplePic temp
|
||||
, AlbumSampleWidth =. width
|
||||
]
|
||||
setMessage "Album settings changed successfully"
|
||||
redirect AdminR
|
||||
|
@ -120,7 +118,6 @@ adminAlbumSettingsForm album albumId users = Album
|
|||
<*> areq (userField users) (bfs ("This album shared with" :: T.Text)) (Just $ albumShares album)
|
||||
<*> pure (albumContent album)
|
||||
<*> aopt (selectField media) (bfs ("Sample picture" :: T.Text)) (Just $ albumSamplePic album)
|
||||
<*> pure 230
|
||||
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
|
||||
where
|
||||
media = do
|
||||
|
|
|
@ -43,7 +43,7 @@ getAdminCommentDeleteR commentId = do
|
|||
Right _ -> do
|
||||
tempComment <- runDB $ get commentId
|
||||
case tempComment of
|
||||
Just comment -> do
|
||||
Just _ -> do
|
||||
-- delete comment children
|
||||
children <- runDB $ selectList [CommentParent ==. Just commentId] []
|
||||
_ <- mapM (\child -> do
|
||||
|
|
|
@ -97,11 +97,8 @@ adminMediumSetForm medium = Medium
|
|||
<*> pure (mediumOwner medium)
|
||||
<*> aopt textareaField (bfs ("Description" :: T.Text)) (Just $ mediumDescription medium)
|
||||
<*> areq tagField (bfs ("Tags" :: T.Text)) (Just $ mediumTags medium)
|
||||
<*> pure (mediumWidth medium)
|
||||
<*> pure (mediumThumbWidth medium)
|
||||
<*> pure (mediumAlbum medium)
|
||||
<*> pure (mediumPreview medium)
|
||||
<*> pure (mediumPreviewWidth medium)
|
||||
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
|
||||
|
||||
getAdminMediumDeleteR :: MediumId -> Handler Html
|
||||
|
|
|
@ -17,9 +17,7 @@
|
|||
module Handler.AlbumSettings where
|
||||
|
||||
import Import
|
||||
import Handler.Commons
|
||||
import qualified Data.Text as T
|
||||
import Data.Maybe
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import qualified Data.List as L
|
||||
|
@ -108,14 +106,10 @@ postAlbumSettingsR albumId = do
|
|||
else do
|
||||
return [()]
|
||||
-- nothing to do here
|
||||
sample <- runDB $ selectFirst
|
||||
[MediumThumb ==. (fromMaybe "" $ albumSamplePic temp)] []
|
||||
let width = if isNothing sample then 230 else mediumThumbWidth $ entityVal $ fromJust sample
|
||||
_ <- runDB $ update albumId
|
||||
[ AlbumTitle =. albumTitle temp
|
||||
, AlbumShares =. newShares
|
||||
, AlbumSamplePic =. albumSamplePic temp
|
||||
, AlbumSampleWidth =. width
|
||||
]
|
||||
setMessage "Album settings changed succesfully"
|
||||
redirect $ AlbumR albumId
|
||||
|
@ -139,7 +133,6 @@ albumSettingsForm album albumId users = Album
|
|||
<*> areq (userField users) (bfs ("Share this album with" :: T.Text)) (Just $ albumShares album)
|
||||
<*> pure (albumContent album)
|
||||
<*> aopt (selectField media) (bfs ("Sample picture" :: T.Text)) (Just $ albumSamplePic album)
|
||||
<*> pure 230
|
||||
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
|
||||
where
|
||||
media = do
|
||||
|
|
|
@ -17,11 +17,9 @@
|
|||
module Handler.Medium where
|
||||
|
||||
import Import
|
||||
import Handler.Commons
|
||||
import Data.Time
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
-- import System.Locale
|
||||
import System.FilePath
|
||||
import Yesod.Markdown
|
||||
import Yesod.RssFeed
|
||||
|
@ -61,7 +59,6 @@ getMediumR mediumId = do
|
|||
[ CommentOrigin ==. mediumId
|
||||
, CommentParent !=. Nothing ]
|
||||
[ Desc CommentTime ]
|
||||
let dataWidth = if mediumWidth medium >= 850 then 850 else mediumWidth medium
|
||||
let tr = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumThumb medium) []
|
||||
let pr = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPreview medium) []
|
||||
let ir = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []
|
||||
|
@ -90,7 +87,7 @@ postMediumR mediumId = do
|
|||
commentForm userId userSl mediumId Nothing
|
||||
case res of
|
||||
FormSuccess temp -> do
|
||||
cId <- runDB $ insert temp
|
||||
runDB $ insert_ temp
|
||||
--send mail to medium owner
|
||||
owner <- runDB $ getJust $ mediumOwner medium
|
||||
link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender
|
||||
|
@ -168,7 +165,7 @@ postCommentReplyR commentId = do
|
|||
commentForm userId userSl mediumId (Just commentId)
|
||||
case res of
|
||||
FormSuccess temp -> do
|
||||
cId <- runDB $ insert temp
|
||||
runDB $ insert_ temp
|
||||
--send mail to parent author
|
||||
parent <- runDB $ getJust $ fromJust $ commentParent temp
|
||||
parAuth <- runDB $ getJust $ commentAuthor parent
|
||||
|
|
|
@ -72,11 +72,8 @@ mediumSettingsForm medium = Medium
|
|||
<*> pure (mediumOwner medium)
|
||||
<*> aopt textareaField (bfs ("Description" :: T.Text)) (Just $ mediumDescription medium)
|
||||
<*> areq tagField (bfs ("tags" :: T.Text)) (Just $ mediumTags medium)
|
||||
<*> pure (mediumWidth medium)
|
||||
<*> pure (mediumThumbWidth medium)
|
||||
<*> pure (mediumAlbum medium)
|
||||
<*> pure (mediumPreview medium)
|
||||
<*> pure (mediumPreviewWidth medium)
|
||||
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text)
|
||||
|
||||
getMediumDeleteR :: MediumId -> Handler Html
|
||||
|
|
|
@ -17,7 +17,6 @@
|
|||
module Handler.NewAlbum where
|
||||
|
||||
import Import
|
||||
import Handler.Commons
|
||||
import Data.Text as T
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
|
@ -75,5 +74,4 @@ albumForm userId = Album
|
|||
<*> pure []
|
||||
<*> pure []
|
||||
<*> pure Nothing
|
||||
<*> pure 230
|
||||
<* bootstrapSubmit ("Create album" :: BootstrapSubmit Text)
|
||||
|
|
|
@ -17,7 +17,6 @@
|
|||
module Handler.Upload where
|
||||
|
||||
import Import as I
|
||||
import Handler.Commons
|
||||
import Data.Time
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
|
@ -89,7 +88,7 @@ postDirectUploadR albumId = do
|
|||
tempName <- if length indFils == 1
|
||||
then return $ fileBulkPrefix temp
|
||||
else return (fileBulkPrefix temp `T.append` " " `T.append` T.pack (show (index :: Int)) `T.append` " of " `T.append` T.pack (show (length indFils)))
|
||||
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) (metaImageWidth meta) (metaThumbWidth meta) albumId ('/' : metaPreviewPath meta) (metaPreviewWidth meta)
|
||||
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) albumId ('/' : metaPreviewPath meta)
|
||||
mId <- runDB $ I.insert medium
|
||||
inALbum <- runDB $ getJust albumId
|
||||
let newMediaList = mId : albumContent inALbum
|
||||
|
@ -129,9 +128,6 @@ postDirectUploadR albumId = do
|
|||
data ThumbsMeta = ThumbsMeta
|
||||
{ metaThumbPath :: FP.FilePath -- ^ Filepath of the new thumbnail image
|
||||
, metaPreviewPath :: FP.FilePath -- ^ Filepath of the new preview image
|
||||
, metaImageWidth :: Int -- ^ Width of the original image
|
||||
, metaThumbWidth :: Int -- ^ Width of the generated thumbnail image
|
||||
, metaPreviewWidth :: Int -- ^ Width of the generated preview image
|
||||
}
|
||||
|
||||
-- | generate thumbnail and preview images from uploaded image
|
||||
|
@ -165,9 +161,6 @@ generateThumbs path uId aId = do
|
|||
return $ ThumbsMeta
|
||||
{ metaThumbPath = tPath
|
||||
, metaPreviewPath = pPath
|
||||
, metaImageWidth = oWidth
|
||||
, metaThumbWidth = tWidth
|
||||
, metaPreviewWidth = pWidth
|
||||
}
|
||||
|
||||
checkCVE_2016_3714 :: FP.FilePath -> Text -> IO Bool
|
||||
|
@ -300,7 +293,7 @@ postUploadR = do
|
|||
T.pack (show (index :: Int)) `T.append`
|
||||
" of " `T.append`
|
||||
T.pack (show (length indFils)))
|
||||
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) (metaImageWidth meta) (metaThumbWidth meta) inAlbumId ('/' : metaPreviewPath meta) (metaPreviewWidth meta)
|
||||
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) inAlbumId ('/' : metaPreviewPath meta)
|
||||
mId <- runDB $ I.insert medium
|
||||
inALbum <- runDB $ getJust inAlbumId
|
||||
let newMediaList = mId : albumContent inALbum
|
||||
|
|
87
Model.hs
87
Model.hs
|
@ -17,8 +17,8 @@
|
|||
module Model where
|
||||
|
||||
import ClassyPrelude.Yesod
|
||||
import Yesod.Markdown (Markdown, unMarkdown)
|
||||
import Database.Persist.Quasi
|
||||
import Yesod.Markdown
|
||||
import qualified System.FilePath as FP
|
||||
|
||||
-- You can define all of your database entities in the entities file.
|
||||
|
@ -27,88 +27,3 @@ import qualified System.FilePath as FP
|
|||
-- http://www.yesodweb.com/book/persistent/
|
||||
share [mkPersist sqlSettings, mkMigrate "migrateAll"]
|
||||
$(persistFileWith lowerCaseSettings "config/models")
|
||||
|
||||
data ESInput = ESUser UserId User
|
||||
| ESAlbum AlbumId Album
|
||||
| ESMedium MediumId Medium
|
||||
| ESComment CommentId Comment
|
||||
|
||||
data FullUser = FullUser
|
||||
{userRep :: User}
|
||||
|
||||
instance ToJSON User where
|
||||
toJSON (User name slug _ _ _ _ _) =
|
||||
object
|
||||
[ "name" .= name
|
||||
, "slug" .= slug
|
||||
]
|
||||
|
||||
instance ToJSON FullUser where
|
||||
toJSON (FullUser user) =
|
||||
object
|
||||
[ "name" .= (userName user)
|
||||
, "slug" .= (userSlug user)
|
||||
, "albums" .= (userAlbums user)
|
||||
]
|
||||
|
||||
data FullAlbum = FullAlbum
|
||||
{albumRep :: Album}
|
||||
|
||||
instance ToJSON Album where
|
||||
toJSON (Album title _ _ _ _ _) =
|
||||
object
|
||||
[ "name" .= title ]
|
||||
|
||||
instance ToJSON FullAlbum where
|
||||
toJSON (FullAlbum album) =
|
||||
object
|
||||
[ "name" .= (albumTitle album)
|
||||
, "owner" .= (albumOwner album)
|
||||
, "shares" .= (albumShares album)
|
||||
, "content" .= (albumContent album)
|
||||
]
|
||||
|
||||
data FullMedium = FullMedium
|
||||
{mediumRep :: Medium}
|
||||
|
||||
instance ToJSON Medium where
|
||||
toJSON (Medium title _ _ _ time _ desc tags _ _ _ _ _) =
|
||||
object
|
||||
[ "name" .= title
|
||||
, "time" .= time
|
||||
, "description" .= desc
|
||||
, "tags" .= tags
|
||||
]
|
||||
|
||||
instance ToJSON FullMedium where
|
||||
toJSON (FullMedium medium) =
|
||||
object
|
||||
[ "name" .= (mediumTitle medium)
|
||||
, "time" .= (mediumTime medium)
|
||||
, "owner" .= (mediumOwner medium)
|
||||
, "description" .= (mediumDescription medium)
|
||||
, "tage" .= (mediumTags medium)
|
||||
, "album" .= (mediumAlbum medium)
|
||||
]
|
||||
|
||||
data FullComment = FullComment
|
||||
{commentRep :: Comment}
|
||||
|
||||
instance ToJSON Comment where
|
||||
toJSON (Comment _ slug _ _ time cont) =
|
||||
object
|
||||
[ "author" .= slug
|
||||
, "time" .= time
|
||||
, "content" .= (unMarkdown cont)
|
||||
]
|
||||
|
||||
instance ToJSON FullComment where
|
||||
toJSON (FullComment comment) =
|
||||
object
|
||||
[ "author_id" .= (commentAuthor comment)
|
||||
, "author" .= (commentAuthorSlug comment)
|
||||
, "origin" .= (commentOrigin comment)
|
||||
, "parent" .= (commentParent comment)
|
||||
, "time" .= (commentTime comment)
|
||||
, "content" .= (unMarkdown $ commentContent comment)
|
||||
]
|
||||
|
|
|
@ -68,7 +68,7 @@ cabal sandbox init
|
|||
build the source with
|
||||
|
||||
```bash
|
||||
cabal install
|
||||
cabal build
|
||||
```
|
||||
|
||||
Everything should work automagically from there.
|
||||
|
@ -76,7 +76,7 @@ Everything should work automagically from there.
|
|||
##Deploying
|
||||
|
||||
After compiling you will find an executable called `eidolon` in
|
||||
`dist/dist-sandbox-XXXXXXXX/build/eidolon/eidolon`. Copy or link it anywhere you
|
||||
`dist/build/eidolon/eidolon`. Copy or link it anywhere you
|
||||
want. The executable needs to be accompanied by the folders `config` and
|
||||
`static` and their contents. It's best to copy them to your desired destination.
|
||||
|
||||
|
|
|
@ -39,7 +39,7 @@ Album
|
|||
shares [UserId]
|
||||
content [MediumId]
|
||||
samplePic FP.FilePath Maybe
|
||||
sampleWidth Int
|
||||
-- sampleWidth Int
|
||||
deriving Eq Show
|
||||
Medium
|
||||
title Text
|
||||
|
@ -50,11 +50,11 @@ Medium
|
|||
owner UserId
|
||||
description Textarea Maybe
|
||||
tags Texts
|
||||
width Int
|
||||
thumbWidth Int
|
||||
-- width Int
|
||||
-- thumbWidth Int
|
||||
album AlbumId
|
||||
preview FP.FilePath
|
||||
previewWidth Int
|
||||
-- previewWidth Int
|
||||
deriving Eq Show
|
||||
Comment
|
||||
author UserId
|
||||
|
|
Loading…
Reference in a new issue