adding licence data type

This commit is contained in:
nek0 2016-12-19 00:28:07 +01:00
parent 4639e7e260
commit 63b1f4b27f
6 changed files with 56 additions and 6 deletions

View file

@ -97,7 +97,10 @@ adminMediumSetForm medium = Medium
<*> areq tagField (bfs ("Tags" :: T.Text)) (Just $ mediumTags medium)
<*> pure (mediumAlbum medium)
<*> pure (mediumPreview medium)
<*> areq (selectField licenses) (bfs ("Licence" :: T.Text)) (Just $ mediumLicence medium)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
where
licenses = optionsPairs $ map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6]
getAdminMediumDeleteR :: MediumId -> Handler Html
getAdminMediumDeleteR mediumId = do

View file

@ -139,6 +139,7 @@ adminProfileForm owner = User
<*> pure (userSalted owner)
<*> pure (userAlbums owner)
<*> areq boolField (bfs ("Admin" :: T.Text)) (Just $ userAdmin owner)
<*> areq (selectField optionsEnum) (bfs ("Default licence" :: T.Text) (Just $ userDefaultLicense owner)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text)
getAdminProfileDeleteR :: UserId -> Handler Html

View file

@ -67,4 +67,8 @@ profileSettingsForm user = User
<*> pure (userSalted user)
<*> pure (userAlbums user)
<*> pure (userAdmin user)
<*> areq (selectField licences) (bfs ("Default licence for media" :: T.Text))
(Just $ userDefaultLicence user)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
where
licenses = optionsPairs $ map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6]

View file

@ -61,7 +61,7 @@ postSignupR = do
case namesakes of
[] -> do
salt <- liftIO generateSalt
let newUser = User newUserName newUserName (fromJust mEmail) salt "" [] False
let newUser = User newUserName newUserName (fromJust mEmail) salt "" [] False (fromEnum AllRightsReserved)
activatorText <- liftIO generateString
_ <- runDB $ insert $ Activator activatorText newUser
_ <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing

View file

@ -27,3 +27,48 @@ import qualified System.FilePath as FP
-- http://www.yesodweb.com/book/persistent/
share [mkPersist sqlSettings, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "config/models")
data Licence
= AllRightsReserved
| CC0
| CCBy4
| CCBySa4
| CCByNd4
| CCByNc4
| CCByNcSa4
| CCByNcNd4
| PublicDomain
instance Show Licence where
show AllRightsReserved = "All rights reserved"
show CC0 = "CC0 1.0"
show CCBy4 = "CC-BY 4.0 International"
show CCBySa4 = "CC-BY-SA 4.0 International"
show CCByNd4 = "CC-BY-ND 4.0 International"
show CCByNc4 = "CC-BY-NC 4.0 International"
show CCByNcSa4 = "CC-BY-NC-SA 4.0 International"
show CCByNcNd4 = "CC-BY-NC-ND 4.0 International"
show PublicDomain = "Public Domain"
instance Enum Licence where
fromEnum PublicDomain = -2
fromEnum AllRightsReserved = -1
fromEnum CC0 = 0
fromEnum CCBy4 = 1
fromEnum CCBySa4 = 2
fromEnum CCByNd4 = 3
fromEnum CCByNc4 = 4
fromEnum CCByNcSa4 = 5
fromEnum CCByNcNd4 = 6
fromEnum n = error $ "no licence no. for" ++ show n
toEnum (-2) = PublicDomain
toEnum (-1) = AllRightsReserved
toEnum 0 = CC0
toEnum 1 = CCBy4
toEnum 2 = CCBySa4
toEnum 3 = CCByNd4
toEnum 4 = CCByNc4
toEnum 5 = CCByNcSa4
toEnum 6 = CCByNcNd4
toEnum n = error $ "No licence no. " ++ show n

View file

@ -22,6 +22,7 @@ User
salted ByteString
albums [AlbumId]
admin Bool
defaultLicence Int default=-1
UniqueUser name
deriving Typeable Eq Show
Activator
@ -39,7 +40,6 @@ Album
shares [UserId]
content [MediumId]
samplePic FP.FilePath Maybe
-- sampleWidth Int
deriving Eq Show
Medium
title Text
@ -50,15 +50,12 @@ Medium
owner UserId
description Textarea Maybe
tags Texts
-- width Int
-- thumbWidth Int
album AlbumId
preview FP.FilePath
-- previewWidth Int
licence Int default=-1
deriving Eq Show
Comment
author UserId
-- authorSlug Text
origin MediumId
parent CommentId Maybe
time UTCTime