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

finished implementation

Browse source 
finished implementation so far. now I need to wait for a newer ghc
withoout bugs.
This commit is contained in:
nek0 2016-10-20 21:05:47 +02:00
parent 0fbbadb979
commit 0cfbc9193c
1 changed files with 15 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
Handler/MediumSettings.hs
View file

@ -18,10 +18,9 @@ module Handler.MediumSettings where
import Import import Import
import Handler.Commons import Handler.Commons
import System.Directory
import System.FilePath import System.FilePath
import qualified Data.Text as T import qualified Data.Text as T
import Data.List (tail) import Data.Maybe (catMaybes)
getMediumSettingsR :: MediumId -> Handler Html getMediumSettingsR :: MediumId -> Handler Html
getMediumSettingsR mediumId = do getMediumSettingsR mediumId = do
@ -124,37 +123,42 @@ getMediumMoveR :: MediumId -> Handler Html
getMediumMoveR mId = do getMediumMoveR mId = do
checkRes <- mediumCheck mId checkRes <- mediumCheck mId
case checkRes of case checkRes of
Right medium -> Right medium -> do
(mediumSettingsWidget, enctype) <- generateFormPost $ (mediumMoveWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $ renderBootstrap3 BootstrapBasicForm $
mediumMoveForm medium mediumMoveForm medium
defaultLayout $ do
setTitle "Eidolon :: Move Medium"
$(widgetFile "mediumMove")
Left (err, route) -> do Left (err, route) -> do
setMessage err setMessage err
redirect route redirect route
postMediumMoveR :: MediumOd -> Handler Html postMediumMoveR :: MediumId -> Handler Html
postMediumMoveR mId = do postMediumMoveR mId = do
checkRes <- mediumCheck mId checkRes <- mediumCheck mId
case checkres of case checkRes of
Right medium -> do Right medium -> do
((res, _), _) <- runFormPost $ ((res, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $ renderBootstrap3 BootstrapBasicForm $
mediumMoveForm medium mediumMoveForm medium
case res of case res of
FormSuccess aId -> FormSuccess aId -> do
moveMedium medium mId aId moveMedium medium mId aId
setMessage "Medium successfully moved"
redirect $ MediumR mId
mediumMoveForm :: Medium -> AForm Handler AlbumId mediumMoveForm :: Medium -> AForm Handler AlbumId
mediumMoveForm medium = id mediumMoveForm medium = id
<$> areq (selectField albums) (bfs ("Destination album" :: T.Text)) (mediumAlbum medium) <$> areq (selectField albums) (bfs ("Destination album" :: T.Text)) (Just $ mediumAlbum medium)
<* bootstrapSubmit ("Move medium" :: BootstrapSubmit Text) <* bootstrapSubmit ("Move medium" :: BootstrapSubmit Text)
where where
albums = do albums = do
allEnts <- runDB $ selectList [] [Asc AlbumTitle] allEnts <- runDB $ selectList [] [Asc AlbumTitle]
let ents = catMaybes $ map (\ent -> ents <- return $ catMaybes $ map (\ent ->
if uId == albumOwner (entityVal ent) || uId `elem` albumShares (entityVal nt) if uId == albumOwner (entityVal ent) || uId `elem` albumShares (entityVal ent)
then Just ent then Just ent
else Nothing else Nothing
) allEnts ) allEnts
optionsPairs $ map (\alb -> ((albumTitle $ entityVal alb), entityKey alb) ents optionsPairs $ map (\alb -> ((albumTitle $ entityVal alb), entityKey alb)) ents
uId = mediumOwner medium uId = mediumOwner medium