clckwrks-plugin-page 0.3.10 → 0.4.0
raw patch · 4 files changed
+27/−12 lines, 4 filesdep ~aeson
Dependency ranges changed: aeson
Files
- Clckwrks/Page/Acid.hs +3/−3
- Clckwrks/Page/Admin/EditPage.hs +8/−5
- Clckwrks/Page/Types.hs +14/−2
- clckwrks-plugin-page.cabal +2/−2
Clckwrks/Page/Acid.hs view
@@ -96,7 +96,7 @@ $ clckwrks-cli _state/profileData_socket -that should start an interactive session. If the server is running as `root`, then you may need to add a `sudo` in front. +that should start an interactive session. If the server is running as `root`, then you may need to add a `sudo` in front. Assuming you are `UserId 1` you can now give yourself admin access: @@ -119,7 +119,7 @@ , pageAuthor = UserId 1 , pageTitle = "Welcome To clckwrks!" , pageSlug = Just $ slugify "Welcome to clckwrks"- , pageSrc = Markup { preProcessors = [ Markdown ]+ , pageSrc = Markup { preProcessors = [ Pandoc ] , trust = Trusted , markup = initialPageMarkup }@@ -179,7 +179,7 @@ , pageAuthor = uid , pageTitle = "Untitled" , pageSlug = Nothing- , pageSrc = Markup { preProcessors = [ Markdown ]+ , pageSrc = Markup { preProcessors = [ Pandoc ] , trust = Trusted , markup = Text.empty }
Clckwrks/Page/Admin/EditPage.hs view
@@ -60,7 +60,7 @@ <*> (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)))+ <*> divControlGroup (label' "Markdown processor" ++> (divControls $ select [(Pandoc, "Pandoc"), (Markdown, "markdown perl script (legacy)" :: Text), (HsColour, "markdown perl script + hscolour (legacy)")] (\p -> p `elem` (preProcessors $ pageSrc page)))) <*> (divControlGroup (label' "Body" ++> (divControls $ textarea 80 25 (markup (pageSrc page)) `setAttrs` [("class" := "input-xxlarge") :: Attr Text Text]))) <*> (divFormActions ((,,) <$> (inputSubmit' (Text.pack "Save"))@@ -90,18 +90,21 @@ newPublishStatus :: PublishStatus -> PageForm (Maybe PublishStatus) newPublishStatus Published = fmap (const Draft) <$> (inputSubmit' (Text.pack "Unpublish") `setAttrs` [("class" := "btn btn-warning") :: Attr Text Text]) 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, ThemeStyleId, Text.Text, Text.Text, Bool, Text.Text, (Maybe Text.Text, Maybe Text.Text, Maybe PublishStatus))+ (PageKind, ThemeStyleId, Text.Text, Text.Text, PreProcessor, Text.Text, (Maybe Text.Text, Maybe Text.Text, Maybe PublishStatus)) -> m (Either PageFormError (Page, AfterSaveAction))- toPage (kind, style, ttl, slug, haskell, bdy, (msave, mpreview, mpagestatus)) =+ toPage (kind, style, ttl, slug, markup, bdy, (msave, mpreview, mpagestatus)) = do now <- liftIO $ getCurrentTime return $ Right $ ( Page { pageId = pageId page , pageAuthor = pageAuthor page , pageTitle = ttl , pageSlug = if Text.null slug then Nothing else Just (slugify slug)- , pageSrc = Markup { preProcessors = (if haskell then ([ HsColour ] ++) else id) [ Markdown ]+ , pageSrc = Markup { preProcessors =+ case markup of+ Markdown -> [ Markdown ]+ HsColour -> [ Markdown, HsColour ]+ Pandoc -> [ Pandoc ] , trust = Trusted , markup = bdy }
Clckwrks/Page/Types.hs view
@@ -4,6 +4,7 @@ import Clckwrks (UserId(..)) import Clckwrks.Markup.HsColour (hscolour) import Clckwrks.Markup.Markdown (markdown)+import Clckwrks.Markup.Pandoc (pandoc) import Clckwrks.Monad (ThemeStyleId(..)) import Clckwrks.Types (Trust(..)) import Control.Applicative ((<$>), optional)@@ -40,13 +41,23 @@ instance FromJSON PageId where parseJSON n = PageId <$> parseJSON n +data PreProcessor_1+ = HsColour_1+ | Markdown_1+ deriving (Eq, Ord, Read, Show, Data, Typeable)+$(deriveSafeCopy 1 'base ''PreProcessor_1)+ data PreProcessor = HsColour | Markdown+ | Pandoc deriving (Eq, Ord, Read, Show, Data, Typeable)-$(deriveSafeCopy 1 'base ''PreProcessor)+$(deriveSafeCopy 2 'extension ''PreProcessor) --- $(deriveJSON id ''PreProcessor)+instance Migrate PreProcessor where+ type MigrateFrom PreProcessor = PreProcessor_1+ migrate HsColour_1 = HsColour+ migrate Markdown_1 = Markdown runPreProcessors :: (MonadIO m) => [PreProcessor] -> Trust -> Text -> m (Either Text Text) runPreProcessors [] _ txt = return (Right txt)@@ -61,6 +72,7 @@ do let f = case pproc of Markdown -> markdown Nothing trust HsColour -> hscolour Nothing+ Pandoc -> pandoc Nothing trust f txt data Markup_001
clckwrks-plugin-page.cabal view
@@ -1,5 +1,5 @@ name: clckwrks-plugin-page-version: 0.3.10+version: 0.4.0 synopsis: support for CMS/Blogging in clckwrks homepage: http://www.clckwrks.com/ license: BSD3@@ -38,7 +38,7 @@ other-modules: Clckwrks.Page.Verbatim build-depends: base >= 4.3 && < 4.9,- aeson >= 0.6 && < 0.9,+ aeson >= 0.6 && < 0.10, acid-state == 0.12.*, attoparsec >= 0.10 && < 0.14, clckwrks >= 0.21 && < 0.24,