adding licence data type

Handler/AdminMediumSettings.hs

@@ -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

Handler/AdminProfileSettings.hs

@@ -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

Handler/ProfileSettings.hs

@@ -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]

Handler/Signup.hs

@@ -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

Model.hs

@@ -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

config/models

@@ -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