clckwrks-plugin-page 0.2.6 → 0.3.0
raw patch · 8 files changed
+65/−29 lines, 8 filesdep ~clckwrks
Dependency ranges changed: clckwrks
Files
- Clckwrks/Page/Acid.hs +3/−0
- Clckwrks/Page/Admin/EditPage.hs +15/−9
- Clckwrks/Page/Admin/PreviewPage.hs +1/−1
- Clckwrks/Page/BlogPage.hs +1/−1
- Clckwrks/Page/Monad.hs +1/−0
- Clckwrks/Page/Route.hs +1/−1
- Clckwrks/Page/Types.hs +41/−15
- clckwrks-plugin-page.cabal +2/−2
Clckwrks/Page/Acid.hs view
@@ -23,6 +23,7 @@ import Clckwrks.Page.Types (Markup(..), PublishStatus(..), PreProcessor(..), PageId(..), PageKind(..), Page(..), Pages(..), FeedConfig(..), Slug(..), initialFeedConfig, slugify) import Clckwrks.Page.Verbatim (verbatimText) import Clckwrks.Types (Trust(..))+import Clckwrks.Monad (ThemeStyleId(..)) import Control.Applicative ((<$>)) import Control.Monad.Reader (ask) import Control.Monad.State (get, modify, put)@@ -128,6 +129,7 @@ , pageStatus = Published , pageKind = PlainPage , pageUUID = fromJust $ UUID.fromString "c306fe3a-8346-11e1-8001-0021cc712949"+ , pageThemeStyleId = ThemeStyleId 0 } ] , feedConfig = fc@@ -187,6 +189,7 @@ , pageStatus = Draft , pageKind = pk , pageUUID = uuid+ , pageThemeStyleId = ThemeStyleId 0 } put $ ps { nextPageId = PageId $ succ $ unPageId nextPageId , pages = insert page pages
Clckwrks/Page/Admin/EditPage.hs view
@@ -5,19 +5,20 @@ ) where import Control.Applicative ((<$>), (<*>), (<*))-import Clckwrks+import Clckwrks hiding (transform) import Clckwrks.Admin.Template (template)-import Clckwrks.Page.Monad (PageM, PageForm, PageFormError)+import Clckwrks.Page.Monad (PageM, PageForm, PageFormError(..)) import Clckwrks.Page.Acid (Markup(..), Page(..), PageKind(..), PublishStatus(..), PreProcessor(..), PageById(..), UpdatePage(..)) import Clckwrks.Page.Types (PageId(..), Slug(..), toSlug, slugify) import Clckwrks.Page.URL (PageURL(..), PageAdminURL(..))+import Control.Monad.State (get) import Data.Maybe (isJust, maybe) import qualified Data.Text as Text import Data.Text.Lazy (Text) import Data.Time.Clock (getCurrentTime) import HSP.XML import HSP.XMLGenerator-import Text.Reform ((<++), (++>), mapView, transformEitherM)+import Text.Reform ((<++), (++>), mapView, transformEitherM, transform, decimal) import Text.Reform.Happstack (reform) import Text.Reform.HSP.Text (form, button, inputCheckbox, inputText, labelText, inputSubmit, select, textarea, fieldset, ol, li, setAttrs) @@ -33,9 +34,10 @@ Nothing -> notFound $ toResponse $ "Page not found: " ++ show (unPageId pid) (Just page) -> do action <- showURL here+ styles <- getThemeStyles =<< plugins <$> get template "edit page" () $ <%>- <% reform (form action) "ep" updatePage Nothing (pageFormlet page) %>+ <% reform (form action) "ep" updatePage Nothing (pageFormlet styles page) %> </%> where updatePage :: (Page, AfterSaveAction) -> PageM Response@@ -47,12 +49,15 @@ ShowPreview -> seeOtherURL (PageAdmin $ PreviewPage (pageId page)) -pageFormlet :: Page -> PageForm (Page, AfterSaveAction)-pageFormlet page =+pageFormlet :: [(ThemeStyleId, ThemeStyle)] -> Page -> PageForm (Page, AfterSaveAction)+pageFormlet styles' page =+ let styles = map (\(i, ts) -> (i, themeStyleName ts)) styles' in divHorizontal $ (fieldset $- (,,,,,)+ (,,,,,,) <$> (divControlGroup (label' "Page Type" ++> (divControls $ select [(PlainPage, ("page" :: Text)), (Post, "post")] (== (pageKind page)))))+-- <*> (divControlGroup (label' "Theme Style" ++> (divControls $ ThemeStyleId <$> (select styles (const True)) `transform` (decimal (const PageErrorInternal)))))+ <*> (divControlGroup (label' "Theme Style" ++> (divControls $ select styles (== (fst $ head styles))))) <*> (divControlGroup (label' "Title" ++> (divControls $ inputText (pageTitle page) `setAttrs` [("size" := "80"), ("class" := "input-xxlarge") :: Attr Text Text]))) <*> (divControlGroup (label' "Slug (optional)" ++> (divControls $ inputText (maybe Text.empty unSlug $ pageSlug page) `setAttrs` [("size" := "80"), ("class" := "input-xxlarge") :: Attr Text Text]))) <*> (divControlGroup (divControls (inputCheckboxLabel ("Highlight Haskell code using HsColour" :: Text) hsColour)))@@ -83,9 +88,9 @@ newPublishStatus _ = fmap (const Published) <$> (inputSubmit' (Text.pack "Publish") `setAttrs` [("class" := "btn btn-success") :: Attr Text Text]) hsColour = HsColour `elem` (preProcessors $ pageSrc page) toPage :: (MonadIO m) =>- (PageKind, Text.Text, Text.Text, Bool, Text.Text, (Maybe Text.Text, Maybe Text.Text, Maybe PublishStatus))+ (PageKind, ThemeStyleId, Text.Text, Text.Text, Bool, Text.Text, (Maybe Text.Text, Maybe Text.Text, Maybe PublishStatus)) -> m (Either PageFormError (Page, AfterSaveAction))- toPage (kind, ttl, slug, haskell, bdy, (msave, mpreview, mpagestatus)) =+ toPage (kind, style, ttl, slug, haskell, bdy, (msave, mpreview, mpagestatus)) = do now <- liftIO $ getCurrentTime return $ Right $ ( Page { pageId = pageId page@@ -104,6 +109,7 @@ Nothing -> pageStatus page , pageKind = kind , pageUUID = pageUUID page+ , pageThemeStyleId = style } , if isJust mpreview then ShowPreview
Clckwrks/Page/Admin/PreviewPage.hs view
@@ -34,5 +34,5 @@ let ttl = pageTitle page bdy <- markupToContent (pageSrc page) addHeaderM "X-XSS-Protection" "0"- clckT2PageT $ themeTemplate (plugins cs) ttl () bdy+ clckT2PageT $ themeTemplate (plugins cs) (pageThemeStyleId page) ttl () bdy else unauthorized (toResponse $ ("Sorry, you need Administrator access to view this page." :: Text))
Clckwrks/Page/BlogPage.hs view
@@ -38,4 +38,4 @@ <% postsHTML %> </div> - clckT2PageT $ themeTemplate (plugins cs) ttl () bdy+ clckT2PageT $ themeTemplate (plugins cs) (ThemeStyleId 0) ttl () bdy
Clckwrks/Page/Monad.hs view
@@ -77,6 +77,7 @@ data PageFormError = PageCFE (CommonFormError [Input])+ | PageErrorInternal deriving Show instance FormError PageFormError where
Clckwrks/Page/Route.hs view
@@ -73,7 +73,7 @@ (Just page) <- query (PageById pid) let ttl = pageTitle page bdy <- markupToContent (pageSrc page)- clckT2PageT $ themeTemplate (plugins cs) ttl () bdy+ clckT2PageT $ themeTemplate (plugins cs) (pageThemeStyleId page) ttl () bdy else do notFound $ toResponse ("Invalid PageId " ++ show (unPageId pid)) (Blog) -> blog
Clckwrks/Page/Types.hs view
@@ -3,6 +3,7 @@ import Clckwrks.Markup.HsColour (hscolour) import Clckwrks.Markup.Markdown (markdown)+import Clckwrks.Monad (ThemeStyleId(..)) import Clckwrks.Types (Trust(..)) import Control.Applicative ((<$>), optional) import Control.Monad.Trans (MonadIO(liftIO))@@ -155,26 +156,51 @@ toSlug :: Text -> Maybe Slug -> Slug toSlug txt slug = fromMaybe (slugify txt) slug +++data Page_3 = Page_3+ { pageId_3 :: PageId+ , pageAuthor_3 :: UserId+ , pageTitle_3 :: Text+ , pageSlug_3 :: Maybe Slug+ , pageSrc_3 :: Markup+ , pageExcerpt_3 :: Maybe Markup+ , pageDate_3 :: UTCTime+ , pageUpdated_3 :: UTCTime+ , pageStatus_3 :: PublishStatus+ , pageKind_3 :: PageKind+ , pageUUID_3 :: UUID+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable)+$(deriveSafeCopy 3 'extension ''Page_3)++instance Migrate Page_3 where+ type MigrateFrom Page_3 = Page_002+ migrate (Page_002 pi pa pt ps pe pd pu pst pk puu) =+ (Page_3 pi pa pt Nothing ps pe pd pu pst pk puu)+ data Page- = Page { pageId :: PageId- , pageAuthor :: UserId- , pageTitle :: Text- , pageSlug :: Maybe Slug- , pageSrc :: Markup- , pageExcerpt :: Maybe Markup- , pageDate :: UTCTime- , pageUpdated :: UTCTime- , pageStatus :: PublishStatus- , pageKind :: PageKind- , pageUUID :: UUID+ = Page { pageId :: PageId+ , pageAuthor :: UserId+ , pageTitle :: Text+ , pageSlug :: Maybe Slug+ , pageSrc :: Markup+ , pageExcerpt :: Maybe Markup+ , pageDate :: UTCTime+ , pageUpdated :: UTCTime+ , pageStatus :: PublishStatus+ , pageKind :: PageKind+ , pageUUID :: UUID+ , pageThemeStyleId :: ThemeStyleId } deriving (Eq, Ord, Read, Show, Data, Typeable)-$(deriveSafeCopy 3 'extension ''Page)+$(deriveSafeCopy 4 'extension ''Page) +-- migration added for clckwrks-plugin-page-0.3.0 on 2013-12-26 instance Migrate Page where- type MigrateFrom Page = Page_002- migrate (Page_002 pi pa pt ps pe pd pu pst pk puu) =- (Page pi pa pt Nothing ps pe pd pu pst pk puu)+ type MigrateFrom Page = Page_3+ migrate (Page_3 pi pa pt psl ps pe pd pu pst pk puu) =+ (Page pi pa pt psl ps pe pd pu pst pk puu (ThemeStyleId 0)) instance Indexable Page where empty = ixSet [ ixFun ((:[]) . pageId)
clckwrks-plugin-page.cabal view
@@ -1,5 +1,5 @@ name: clckwrks-plugin-page-version: 0.2.6+version: 0.3.0 synopsis: support for CMS/Blogging in clckwrks homepage: http://www.clckwrks.com/ license: BSD3@@ -42,7 +42,7 @@ aeson == 0.6.*, acid-state == 0.12.*, attoparsec == 0.10.*,- clckwrks >= 0.18 && < 0.21,+ clckwrks >= 0.21 && < 0.22, containers >= 0.4 && < 0.6, directory >= 1.1 && < 1.3, filepath >= 1.2 && < 1.4,