fixing licences to actual datatypes

This commit is contained in:
nek0 2017-08-06 04:42:31 +02:00
parent aac873d080
commit 1c3fee8b24
14 changed files with 118 additions and 75 deletions

View file

@ -27,6 +27,7 @@ import Database.Persist.Sql -- (ConnectionPool, runSqlPool)
import Settings.StaticFiles
import Settings
import Model
import Licence
import Text.Jasmine (minifym)
import Text.Hamlet (hamletFile)
import Yesod.Core.Types
@ -293,7 +294,7 @@ instance PersistUserCredentials User where
userUserActiveF = UserActive
uniqueUsername = UniqueUser
userCreate name email salt = User name name email salt "" [] False (-1) False
userCreate name email salt = User name name email salt "" [] False AllRightsReserved False
instance PersistToken Token where
tokenTokenTokenF = TokenToken

View file

@ -103,7 +103,8 @@ adminMediumSetForm medium = 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]
licenses = optionsPairs $ map (\a -> (T.pack (show (a :: Licence)), a))
[minBound..maxBound]
getAdminMediumDeleteR :: MediumId -> Handler Html
getAdminMediumDeleteR mediumId = do

View file

@ -142,7 +142,8 @@ adminProfileForm owner = User
<*> pure (userActive owner)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text)
where
licenses = optionsPairs $ map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6]
licenses = optionsPairs $ map (\a -> (T.pack (show (a :: Licence)), a))
[minBound..maxBound]
getAdminProfileDeleteR :: UserId -> Handler Html
getAdminProfileDeleteR ownerId = do

View file

@ -179,7 +179,7 @@ handleUpload
-> UserId -- ^ 'UserId' of media owner
-> Maybe Markdown -- ^ Description text
-> [T.Text] -- ^ Tags
-> Int -- ^ Licence
-> Licence -- ^ Licence
-> UploadSpec -- ^ New file or replacement file?
-> (Int, FileInfo) -- ^ actual file
-> Handler (Maybe T.Text) -- ^ Returns the filename if something fails

View file

@ -63,8 +63,8 @@ getMediumR mediumId = do
(drop 2 $ map T.pack $ splitDirectories $ mediumPreview medium) []
ir = StaticR $ StaticRoute
(drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []
lic = T.pack $ show (toEnum (mediumLicence medium) :: Licence)
link = url (toEnum (mediumLicence medium) :: Licence)
lic = T.pack $ show $ mediumLicence medium
link = url $ mediumLicence medium
defaultLayout $ do
setTitle $ toHtml ("Eidolon :: Medium " `T.append` (mediumTitle medium))
rssLink (CommentFeedRssR mediumId) $

View file

@ -85,7 +85,7 @@ data MediumSettings = MediumSettings
, msData :: Maybe FileInfo
, msDescription :: Maybe Markdown
, msTags :: [T.Text]
, msLicence :: Int
, msLicence :: Licence
}
mediumSettingsForm :: Medium -> AForm Handler MediumSettings
@ -97,7 +97,8 @@ mediumSettingsForm medium = MediumSettings
<*> areq (selectField licences) (bfs ("Licence" :: T.Text)) (Just $ mediumLicence medium)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text)
where
licences = optionsPairs $ map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6]
licences = optionsPairs $ map (\a -> (T.pack (show (a :: Licence)), a))
[minBound..maxBound]
getMediumDeleteR :: MediumId -> Handler Html
getMediumDeleteR mediumId = do

View file

@ -73,4 +73,5 @@ profileSettingsForm user = User
<*> pure (userActive user)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
where
licences = optionsPairs $ map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6]
licences = optionsPairs $ map (\a -> (T.pack (show (a :: Licence)), a))
[minBound..maxBound]

View file

@ -194,7 +194,7 @@ mediumToEntry ent = do
, feedEntryTitle = mediumTitle (entityVal ent)
, feedEntryContent = toHtml ((fromMaybe (Markdown "") $ mediumDescription $ entityVal ent)
`mappend` Markdown (LT.pack "\n\n")
`mappend` Markdown (LT.pack $ show $ (toEnum $ mediumLicence (entityVal ent) :: Licence)))
`mappend` Markdown (LT.pack $ show $ mediumLicence $ entityVal ent))
, feedEntryEnclosure = Just $ EntryEnclosure
(StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPreview $ entityVal ent) [])
size

View file

@ -117,7 +117,8 @@ dUploadForm userId user albumId = FileBulk
<*> areq (selectField licences) (bfs ("Licence" :: T.Text)) (defLicence)
<* bootstrapSubmit ("Upload" :: BootstrapSubmit T.Text)
where
licences = optionsPairs $ I.map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6]
licences = optionsPairs $ I.map (\a -> (T.pack (show a), (a :: Licence)))
[minBound..maxBound]
defLicence = Just $ userDefaultLicence user
@ -129,7 +130,7 @@ data FileBulk = FileBulk
, fileBulkDesc :: Maybe Markdown
, fileBulkTags :: [T.Text]
, fileBulkAlbum :: AlbumId
, fileBulkLicence :: Int
, fileBulkLicence :: Licence
}
getUploadR :: Handler Html
@ -174,7 +175,8 @@ bulkUploadForm userId user = (\a b c d e f g h -> FileBulk b c d e f g a h)
else Nothing
) allEnts
optionsPairs $ I.map (\alb -> (albumTitle $ entityVal alb, entityKey alb)) entities
licences = optionsPairs $ I.map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6]
licences = optionsPairs $ I.map (\a -> (T.pack (show a), (a :: Licence)))
[minBound..maxBound]
defLicence = Just $ userDefaultLicence user
postUploadR :: Handler Html

View file

@ -36,6 +36,7 @@ import Settings.StaticFiles as Import
-- custom imports
import Helper as Import
import Licence as Import
-- end custom imports

92
Licence.hs Executable file
View file

@ -0,0 +1,92 @@
-- eidolon -- A simple gallery in Haskell and Yesod
-- Copyright (C) 2015 Amedeo Molnár
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published
-- by the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
module Licence where
import ClassyPrelude.Yesod
import Database.Persist.Sql
import Data.Bits (bitSizeMaybe)
class ShowUrl a where
url :: a -> Maybe String
data Licence
= PublicDomain
| AllRightsReserved
| CC0
| CCBy4
| CCBySa4
| CCByNd4
| CCByNc4
| CCByNcSa4
| CCByNcNd4
deriving (Eq, Ord, Bounded)
instance ShowUrl Licence where
url PublicDomain = Nothing
url AllRightsReserved = Nothing
url CC0 = Just "https://creativecommons.org/publicdomain/zero/1.0/"
url CCBy4 = Just "https://creativecommons.org/licenses/by/4.0"
url CCBySa4 = Just "https://creativecommons.org/licenses/by-sa/4.0"
url CCByNd4 = Just "https://creativecommons.org/licenses/by-nd/4.0"
url CCByNc4 = Just "https://creativecommons.org/licenses/by-nc/4.0"
url CCByNcSa4 = Just "https://creativecommons.org/licenses/by-nc-sa/4.0"
url CCByNcNd4 = Just "https://creativecommons.org/licenses/by-nc-nd/4.0"
instance Show Licence where
show PublicDomain = "Public Domain"
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"
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
instance PersistField Licence where
toPersistValue = PersistInt64 . fromIntegral . fromEnum
fromPersistValue (PersistInt64 i) = Right $ toEnum $ fromIntegral i
fromPersistValue _ = Left "Licence is to be read form PersistInt"
instance PersistFieldSql Licence where
sqlType _
| Just x <- bitSizeMaybe (0 :: Int), x <= 32 = SqlInt32
| otherwise = SqlInt64

View file

@ -19,8 +19,9 @@ module Model where
import ClassyPrelude.Yesod
import Database.Persist.Quasi
import Text.Markdown
import Yesod.Text.Markdown
import Yesod.Text.Markdown ()
import qualified System.FilePath as FP
import Licence
-- You can define all of your database entities in the entities file.
-- You can find more information on persistent and how to declare entities
@ -28,62 +29,3 @@ import qualified System.FilePath as FP
-- http://www.yesodweb.com/book/persistent/
share [mkPersist sqlSettings, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "config/models")
class ShowUrl a where
url :: a -> Maybe String
data Licence
= AllRightsReserved
| CC0
| CCBy4
| CCBySa4
| CCByNd4
| CCByNc4
| CCByNcSa4
| CCByNcNd4
| PublicDomain
instance ShowUrl Licence where
url PublicDomain = Nothing
url AllRightsReserved = Nothing
url CC0 = Just "https://creativecommons.org/publicdomain/zero/1.0/"
url CCBy4 = Just "https://creativecommons.org/licenses/by/4.0"
url CCBySa4 = Just "https://creativecommons.org/licenses/by-sa/4.0"
url CCByNd4 = Just "https://creativecommons.org/licenses/by-nd/4.0"
url CCByNc4 = Just "https://creativecommons.org/licenses/by-nc/4.0"
url CCByNcSa4 = Just "https://creativecommons.org/licenses/by-nc-sa/4.0"
url CCByNcNd4 = Just "https://creativecommons.org/licenses/by-nc-nd/4.0"
instance Show Licence where
show PublicDomain = "Public Domain"
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"
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,7 +22,7 @@ User
salted ByteString
albums [AlbumId]
admin Bool
defaultLicence Int default=-1
defaultLicence Licence default=-1
active Bool default=True
UniqueUser name
deriving Typeable Eq Show
@ -54,7 +54,7 @@ Medium
tags Texts
album AlbumId
preview FP.FilePath
licence Int default=-1
licence Licence default=-1
deriving Eq Show
Comment
author UserId

View file

@ -26,6 +26,7 @@ library
exposed-modules: Application
Foundation
Helper
Licence
Import
Model
Scale