diff --git a/LambdaCms/Media.hs b/LambdaCms/Media.hs --- a/LambdaCms/Media.hs +++ b/LambdaCms/Media.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/LambdaCms/Media/Foundation.hs b/LambdaCms/Media/Foundation.hs --- a/LambdaCms/Media/Foundation.hs +++ b/LambdaCms/Media/Foundation.hs @@ -6,10 +6,10 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module LambdaCms.Media.Foundation where -import Data.Monoid ((<>)) import Data.Text (Text, unpack) import qualified Data.Text as T import System.FilePath (()) @@ -22,10 +22,13 @@ import qualified LambdaCms.Media.Message as Msg import LambdaCms.Media.Models + data MediaAdmin = MediaAdmin mkYesodSubData "MediaAdmin" $(parseRoutesFile "config/routes") +-- This instance requires OPTIONS_GHC -fno-warn-orphans +-- TODO: Can we avoid surpressing orphan warnings? instance LambdaCmsMedia master => RenderMessage master MediaMessage where renderMessage = renderMediaMessage diff --git a/LambdaCms/Media/Handler/Media.hs b/LambdaCms/Media/Handler/Media.hs --- a/LambdaCms/Media/Handler/Media.hs +++ b/LambdaCms/Media/Handler/Media.hs @@ -3,6 +3,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleContexts #-} module LambdaCms.Media.Handler.Media ( getMediaAdminR @@ -14,7 +15,6 @@ , patchMediaAdminRenameR ) where -import Data.Maybe (fromJust, isJust) import Data.Text (pack, unpack) import qualified Data.Text as T (concat, split) import Data.Time (getCurrentTime, utctDay) @@ -23,8 +23,8 @@ import qualified LambdaCms.Media.Message as Msg import System.Directory import System.FilePath -import Text.Lucius (luciusFile) + getMediaAdminR :: MediaHandler Html getMediaAdminNewR :: MediaHandler Html postMediaAdminNewR :: MediaHandler Html @@ -35,8 +35,8 @@ getMediaAdminR = lift $ do can <- getCan - y <- getYesod - let sr = unpack $ staticRoot y + -- Following line needs +XFlexibleContexts in GHC 7.10+ + let indexItem file mroute = $(widgetFile "index_item") (files :: [Entity Media]) <- runDB $ selectList [] [] adminLayout $ do setTitleI Msg.MediaIndex @@ -52,11 +52,11 @@ postMediaAdminNewR = do ((results, fWidget), enctype) <- lift $ runFormPost uploadForm case results of - FormSuccess (file, name, label, description) -> do - ct <- liftIO getCurrentTime - (location, ctype) <- upload file (unpack name) - _ <- lift . runDB . insert $ Media location ctype label description ct - lift . setMessageI $ Msg.SaveSuccess label + FormSuccess (fileF, nameF, labelF, descriptionF) -> do + now <- liftIO getCurrentTime + (location, ctype) <- upload fileF (unpack nameF) + _ <- lift . runDB . insert $ Media location ctype labelF descriptionF now + lift . setMessageI $ Msg.SaveSuccess labelF redirect MediaAdminR _ -> lift $ do can <- getCan diff --git a/LambdaCms/Media/Import.hs b/LambdaCms/Media/Import.hs --- a/LambdaCms/Media/Import.hs +++ b/LambdaCms/Media/Import.hs @@ -7,10 +7,9 @@ import Prelude as Import hiding (head, init, last, readFile, tail, writeFile) -import Yesod as Import hiding (Route (..)) +import Yesod as Import hiding (Route(..)) import Yesod.Form.Bootstrap3 as Import -import Control.Applicative as Import (pure, (<$>), (<*), (<*>)) import Data.Text as Import (Text) import Text.Hamlet as Import (hamletFile) @@ -19,12 +18,4 @@ import LambdaCms.Media.Foundation as Import import LambdaCms.Media.Models as Import -#if __GLASGOW_HASKELL__ >= 704 -import Data.Monoid as Import (Monoid (mappend, mempty, mconcat), - (<>)) -#else -import Data.Monoid as Import (Monoid (mappend, mempty, mconcat)) -infixr 5 <> -(<>) :: Monoid m => m -> m -> m -(<>) = mappend -#endif +import Data.Monoid as Import ((<>)) diff --git a/LambdaCms/Media/Message.hs b/LambdaCms/Media/Message.hs --- a/LambdaCms/Media/Message.hs +++ b/LambdaCms/Media/Message.hs @@ -8,9 +8,10 @@ , dutchMessage ) where -import Data.Monoid (mappend) +import Data.Monoid as Import ((<>)) import Data.Text (Text) + data MediaMessage = Back | Delete @@ -48,67 +49,67 @@ defaultMessage = englishMessage englishMessage :: MediaMessage -> Text -englishMessage Back = "Back" -englishMessage Delete = "Remove" -englishMessage Save = "Save" -englishMessage Upload = "Upload" -englishMessage Rename = "Rename" -englishMessage AddMedia = "Add media" -englishMessage NoMediaFound = "No media found." -englishMessage CantDisplayFileType = "Can't display file" -englishMessage UnknownFileType = "Unknown file type" -englishMessage MediaIndex = "Media overview" -englishMessage NewMedia = "New media file" -englishMessage (EditMedia label) = label -englishMessage Information = "File information" -englishMessage Preview = "Preview" -englishMessage Location = "File" -englishMessage NewFilename = "New filename" -englishMessage ChangeMediaSettings = "Change media settings" -englishMessage ChangeFilename = "Change filename" -englishMessage Label = "Label" -englishMessage Description = "Description" -englishMessage UploadedOn = "Uploaded on" -englishMessage Filename = "Filename" -englishMessage FileContentType = "Content type" -englishMessage FileLocation = "File location" -englishMessage MenuMedia = "Media" -englishMessage (SaveSuccess label) = "Successfully created: " `mappend` label -englishMessage (UpdateSuccess label) = "Successfully updated: " `mappend` label -englishMessage (DeleteSuccess label) = "Successfully deleted: " `mappend` label -englishMessage (DeleteFail label) = "Failed to delete: " `mappend` label -englishMessage RenameSuccess = "Successfully renamed file" -englishMessage RenameFail = "Failed to rename file" +englishMessage Back = "Back" +englishMessage Delete = "Remove" +englishMessage Save = "Save" +englishMessage Upload = "Upload" +englishMessage Rename = "Rename" +englishMessage AddMedia = "Upload media" +englishMessage NoMediaFound = "No media found." +englishMessage CantDisplayFileType = "Can't display file" +englishMessage UnknownFileType = "Unknown file type" +englishMessage MediaIndex = "Media overview" +englishMessage NewMedia = "New media file" +englishMessage (EditMedia labelM) = labelM +englishMessage Information = "File information" +englishMessage Preview = "Preview" +englishMessage Location = "File" +englishMessage NewFilename = "New filename" +englishMessage ChangeMediaSettings = "Change media settings" +englishMessage ChangeFilename = "Change filename" +englishMessage Label = "Label" +englishMessage Description = "Description" +englishMessage UploadedOn = "Uploaded on" +englishMessage Filename = "Filename" +englishMessage FileContentType = "Content type" +englishMessage FileLocation = "File location" +englishMessage MenuMedia = "Media" +englishMessage (SaveSuccess labelM) = "Successfully created: " <> labelM +englishMessage (UpdateSuccess labelM) = "Successfully updated: " <> labelM +englishMessage (DeleteSuccess labelM) = "Successfully deleted: " <> labelM +englishMessage (DeleteFail labelM) = "Failed to delete: " <> labelM +englishMessage RenameSuccess = "Successfully renamed file" +englishMessage RenameFail = "Failed to rename file" dutchMessage :: MediaMessage -> Text -dutchMessage Back = "Terug" -dutchMessage Delete = "Verwijderen" -dutchMessage Save = "Opslaan" -dutchMessage Upload = "Uploaden" -dutchMessage Rename = "Hernoemen" -dutchMessage AddMedia = "Media toevoegen" -dutchMessage NoMediaFound = "Geen media gevonden." -dutchMessage CantDisplayFileType = "Kan bestand niet weergeven" -dutchMessage UnknownFileType = "Onbekend bestandstype" -dutchMessage MediaIndex = "Media overzicht" -dutchMessage NewMedia = "Nieuw mediabestand" -dutchMessage (EditMedia label) = label -dutchMessage Information = "Bestandsinformatie" -dutchMessage Preview = "Voorvertoning" -dutchMessage Location = "Bestand" -dutchMessage NewFilename = "Nieuwe bestandsnaam" -dutchMessage ChangeMediaSettings = "Pas media instellingen aan" -dutchMessage ChangeFilename = "Bestandsnaam wijzigen" -dutchMessage Label = "Label" -dutchMessage Description = "Beschrijving" -dutchMessage UploadedOn = "Geüpload op" -dutchMessage Filename = "Bestandsnaam" -dutchMessage FileContentType = "Inhoudstype" -dutchMessage FileLocation = "Bestandslocatie" -dutchMessage MenuMedia = "Media" -dutchMessage (SaveSuccess label) = "Succesvol aangemaakt: " `mappend` label -dutchMessage (UpdateSuccess label) = "Succesvol geüpdate: " `mappend` label -dutchMessage (DeleteSuccess label) = "Succesvol verwijderd: " `mappend` label -dutchMessage (DeleteFail label) = "Verwijderen mislukt voor: " `mappend` label -dutchMessage RenameSuccess = "Bestand succesvol hernoemd" -dutchMessage RenameFail = "Hernoemen van bestand mislukt" +dutchMessage Back = "Terug" +dutchMessage Delete = "Verwijderen" +dutchMessage Save = "Opslaan" +dutchMessage Upload = "Uploaden" +dutchMessage Rename = "Hernoemen" +dutchMessage AddMedia = "Media toevoegen" +dutchMessage NoMediaFound = "Geen media gevonden." +dutchMessage CantDisplayFileType = "Kan bestand niet weergeven" +dutchMessage UnknownFileType = "Onbekend bestandstype" +dutchMessage MediaIndex = "Media overzicht" +dutchMessage NewMedia = "Nieuw mediabestand" +dutchMessage (EditMedia labelM) = labelM +dutchMessage Information = "Bestandsinformatie" +dutchMessage Preview = "Voorvertoning" +dutchMessage Location = "Bestand" +dutchMessage NewFilename = "Nieuwe bestandsnaam" +dutchMessage ChangeMediaSettings = "Pas media instellingen aan" +dutchMessage ChangeFilename = "Bestandsnaam wijzigen" +dutchMessage Label = "Label" +dutchMessage Description = "Beschrijving" +dutchMessage UploadedOn = "Geüpload op" +dutchMessage Filename = "Bestandsnaam" +dutchMessage FileContentType = "Inhoudstype" +dutchMessage FileLocation = "Bestandslocatie" +dutchMessage MenuMedia = "Media" +dutchMessage (SaveSuccess labelM) = "Succesvol aangemaakt: " <> labelM +dutchMessage (UpdateSuccess labelM) = "Succesvol geüpdate: " <> labelM +dutchMessage (DeleteSuccess labelM) = "Succesvol verwijderd: " <> labelM +dutchMessage (DeleteFail labelM) = "Verwijderen mislukt voor: " <> labelM +dutchMessage RenameSuccess = "Bestand succesvol hernoemd" +dutchMessage RenameFail = "Hernoemen van bestand mislukt" diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ **NOTE:** At this point the functionality provided by this extension is very basic. Pull request adding features are most welcome. -# Installing +### Installing LambdaCms extensions come as plain Haskell packages and need to be added to the project's `.cabal` file like any other package dependency. @@ -18,7 +18,7 @@ line to `build-depends`: ``` - , lambdacms-media + , lambdacms-media >= 0.2.0 && < 0.3 ``` The media extension's admin section needs to be mounted in the base app's @@ -31,37 +31,37 @@ To `Application.hs` add `import LambdaCms.Media` and the following line: ```haskell -[...] +... let getLambdaCms = CoreAdmin getLambdaCmsMedia = MediaAdmin -- add this line mkFoundation appConnPool = App {..} -[...] +... ``` The procede by including the `migrateLambdaCmsMedia` function to `Application.hs` as shown in this snippet: ```haskell -[...] +... runLoggingT (runSqlPool (mapM_ runMigration [migrateAll, migrateLambdaCmsCore, migrateLambdaCmsMedia]) pool) (messageLoggerSource theFoundation appLogger) -[...] +... ``` To `Foundation.hs` also add `import LambdaCms.Media` and the following two lines: ```haskell -[...] +... , getLambdaCms :: CoreAdmin , getLambdaCmsMedia :: MediaAdmin -- add this line } -[...] +... adminMenu = (defaultCoreAdminMenu CoreAdminR) ++ (defaultMediaAdminMenu MediaAdminR) -- add this line renderLanguages _ = ["en", "nl"] -[...] +... ``` The last line hooks the media admin section into the admin menu. @@ -80,8 +80,38 @@ `yesod devel` to test drive the freshly installed extension. +### Using media in another LambdaCms extension -# License +A common usecase would be to use the "media" that are managed using the +`lambdacms-media` extension in other extensions. For example: to add an +image to a blog post. + +First off all the `lambdacms-media` package needs to become a package +dependency of that particular extension's package. + +Then we can add an `imageId` to the `Post` model. + +``` +Post + title Text + body Text + imageId MediaId Maybe +``` + +To make it all work we need to put a constraint on the type class +defined in the `Foundation.hs`: + +```haskell +... +class LambdaCmsMedia master => MysitePostSub master where +... +``` + +After this the `attachedMaybeMedia` function may be used in the +handler functions of the blog post extension. + + +### License All code in this repository is released under the MIT license, as specified in the [LICENSE file](https://github.com/lambdacms/lambdacms-core/blob/master/LICENSE). diff --git a/lambdacms-media.cabal b/lambdacms-media.cabal --- a/lambdacms-media.cabal +++ b/lambdacms-media.cabal @@ -1,5 +1,5 @@ name: lambdacms-media -version: 0.2.0 +version: 0.3.0 license: MIT license-file: LICENSE author: Mats Rietdijk, Cies Breijs @@ -14,7 +14,7 @@ category: Web build-type: Simple cabal-version: >= 1.18 -tested-with: GHC >= 7.6 +tested-with: GHC >= 7.10 extra-source-files: README.md , CHANGES.md , templates/*.hamlet @@ -40,7 +40,7 @@ build-depends: base >= 4.3 && < 5 , yesod , yesod-form - , lambdacms-core >= 0.0.7.3 && < 0.2 + , lambdacms-core >= 0.2 && < 0.3 , persistent , text , time diff --git a/templates/edit.hamlet b/templates/edit.hamlet --- a/templates/edit.hamlet +++ b/templates/edit.hamlet @@ -9,7 +9,7 @@ $maybe r <- can (mediaR $ MediaAdminEditR fileId) "DELETE"
-