diff --git a/Foundation.hs b/Foundation.hs index 9e5fc0e..7dd74f0 100755 --- a/Foundation.hs +++ b/Foundation.hs @@ -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 diff --git a/Handler/AdminMediumSettings.hs b/Handler/AdminMediumSettings.hs index 159dbf7..9cea131 100755 --- a/Handler/AdminMediumSettings.hs +++ b/Handler/AdminMediumSettings.hs @@ -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 diff --git a/Handler/AdminProfileSettings.hs b/Handler/AdminProfileSettings.hs index cb49343..ea58987 100755 --- a/Handler/AdminProfileSettings.hs +++ b/Handler/AdminProfileSettings.hs @@ -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 diff --git a/Handler/Commons.hs b/Handler/Commons.hs index 4552674..ca89a1f 100755 --- a/Handler/Commons.hs +++ b/Handler/Commons.hs @@ -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 diff --git a/Handler/Medium.hs b/Handler/Medium.hs index 34b6b0c..470fa83 100755 --- a/Handler/Medium.hs +++ b/Handler/Medium.hs @@ -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) $ diff --git a/Handler/MediumSettings.hs b/Handler/MediumSettings.hs index 0af7706..1e0527a 100755 --- a/Handler/MediumSettings.hs +++ b/Handler/MediumSettings.hs @@ -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 diff --git a/Handler/ProfileSettings.hs b/Handler/ProfileSettings.hs index 0916d25..23f4551 100755 --- a/Handler/ProfileSettings.hs +++ b/Handler/ProfileSettings.hs @@ -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] diff --git a/Handler/RootFeed.hs b/Handler/RootFeed.hs index 9b86046..96af181 100755 --- a/Handler/RootFeed.hs +++ b/Handler/RootFeed.hs @@ -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 diff --git a/Handler/Upload.hs b/Handler/Upload.hs index 5780154..b7f669f 100755 --- a/Handler/Upload.hs +++ b/Handler/Upload.hs @@ -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 diff --git a/Import.hs b/Import.hs index dffe4e7..a03535e 100755 --- a/Import.hs +++ b/Import.hs @@ -36,6 +36,7 @@ import Settings.StaticFiles as Import -- custom imports import Helper as Import +import Licence as Import -- end custom imports diff --git a/Licence.hs b/Licence.hs new file mode 100755 index 0000000..b0aa87c --- /dev/null +++ b/Licence.hs @@ -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 . + +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 diff --git a/Model.hs b/Model.hs index 92537b6..95601e0 100755 --- a/Model.hs +++ b/Model.hs @@ -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 diff --git a/config/models b/config/models index 5904ae4..d44f44e 100755 --- a/config/models +++ b/config/models @@ -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 diff --git a/eidolon.cabal b/eidolon.cabal index 418089d..0f420f3 100755 --- a/eidolon.cabal +++ b/eidolon.cabal @@ -26,6 +26,7 @@ library exposed-modules: Application Foundation Helper + Licence Import Model Scale