[clckwrks: run markdown/hscolour and fix parser bug with multiple plugin preprocessors
Jeremy Shaw <jeremy@seereason.com>**20121126201348
 Ignore-this: f9d319bc6f17ef52a973fd821778c925
] hunk ./clckwrks/Clckwrks/Monad.hs 484
-       return (TrustedHtml $ TL.toStrict markup')
+       e <- liftIO $ runPreProcessors preProcessors trust (TL.toStrict markup')
+       case e of
+         (Left err)   -> return (PlainText err)
+         (Right html) -> return (TrustedHtml html)
hunk ./clckwrks/Clckwrks/Monad.hs 501
+      deriving Show
+
+instance Functor Segment where
+    fmap f (TextBlock t) = TextBlock t
+    fmap f (Cmd c)       = Cmd (f c)
hunk ./clckwrks/Clckwrks/Monad.hs 530
-    try $ do char '{'
---             cmd <- takeWhile1 (\c -> notElem c "|}")
-             stringCI n
-             char '|'
-             r <- p
-             char '}'
-             return (Cmd r)
+    do char '{'
+       ((try $ do stringCI n
+                  char '|'
+                  r <- p
+                  char '}'
+                  return (Cmd r))
+             <|>
+             (do t <- takeWhile1 (/= '{')
+                 return $ TextBlock (T.cons '{' t)))
hunk ./clckwrks/Clckwrks/Page/PreProcess.hs 1
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
hunk ./clckwrks/Clckwrks/Page/PreProcess.hs 4
-import Control.Monad.Trans (MonadIO)
+
+import Control.Monad.Trans (MonadIO(..))
hunk ./clckwrks/Clckwrks/Page/PreProcess.hs 7
-import Clckwrks.Monad (ClckT, ClckState, query)
+import Clckwrks.Monad (ClckT, ClckState, transform, query, segments)
hunk ./clckwrks/Clckwrks/Page/PreProcess.hs 11
-import Data.Attoparsec.Text (Parser, anyChar, char, decimal, parseOnly, space, stringCI, try)
+import Data.Attoparsec.Text.Lazy        (Parser, Result(..), anyChar, char, choice, decimal, parse, skipMany, space, stringCI, skipMany, try)
hunk ./clckwrks/Clckwrks/Page/PreProcess.hs 15
+import qualified Data.Text.Lazy         as TL
hunk ./clckwrks/Clckwrks/Page/PreProcess.hs 50
-pageCmd :: (Functor m, MonadIO m) => (ClckURL -> [(Text, Maybe Text)] -> Text) -> Text -> ClckT url m Builder
-pageCmd showURLFn txt =
-    do let mi = parseOnly parseCmd txt
-       case mi of
-         (Left e) ->
-               return $ B.fromString e -- FIXME: format the error more nicely or something?
+pageCmd :: (Functor m, MonadIO m) =>
+           (ClckURL -> [(Text, Maybe Text)] -> Text)
+        -> TL.Text
+        -> ClckT url m TL.Text
+pageCmd clckShowURL txt =
+    case parse (segments "page" parseCmd) txt of
+      (Fail _ _ e) -> return (TL.pack e)
+      (Done _ segments) ->
+          do b <- transform (applyCmd clckShowURL) segments
+             return $ B.toLazyText b
hunk ./clckwrks/Clckwrks/Page/PreProcess.hs 61
-         (Right cmd) ->
-             case cmd of
-               (LinkPage pid mTitle) ->
-                   do (ttl, slug) <-
-                          case mTitle of
-                              (Just t) -> return (t, Just $ slugify t)
-                              Nothing  -> do mttl <- query (GetPageTitle pid)
-                                             case mttl of
-                                               Nothing -> return $ (pack "Untitled", Nothing)
-                                               (Just ttlSlug) -> return ttlSlug
-                      html <- unXMLGenT $ <a href=(showURLFn (ViewPageSlug pid (toSlug ttl slug)) [])><% ttl %></a>
-                      return $ B.fromString $ concat $ lines $ renderAsHTML html
+applyCmd clckShowURL l@(LinkPage pid mTitle) =
+    do (ttl, slug) <-
+           case mTitle of
+             (Just t) -> return (t, Just $ slugify t)
+             Nothing  -> do mttl <- query (GetPageTitle pid)
+                            case mttl of
+                              Nothing -> return $ (pack "Untitled", Nothing)
+                              (Just ttlSlug) -> return ttlSlug
+       html <- unXMLGenT $ <a href=(clckShowURL (ViewPageSlug pid (toSlug ttl slug)) [])><% ttl %></a>
+       return $ B.fromString $ concat $ lines $ renderAsHTML html
hunk ./clckwrks/Clckwrks/Plugin.hs 4
-import Control.Applicative ((<$>))
-import Control.Monad.State (MonadState(get))
hunk ./clckwrks/Clckwrks/Plugin.hs 5
-import Clckwrks.Acid
hunk ./clckwrks/Clckwrks/Plugin.hs 6
-import Clckwrks.Admin.Template     (defaultAdminMenu)
hunk ./clckwrks/Clckwrks/Plugin.hs 10
-import Clckwrks.Monad
-import Clckwrks.URL
-import Clckwrks.Server (checkAuth)
-import Control.Monad
-import Control.Monad.Trans
-import Data.Text (Text)
+import Clckwrks.Page.PreProcess    (pageCmd)
+import Clckwrks.Server             (checkAuth)
+import Control.Monad.State         (MonadState(get))
+import Data.Text                   (Text)
hunk ./clckwrks/Clckwrks/Plugin.hs 15
-import qualified Data.Map as Map
-import Data.Monoid ((<>))
-import Happstack.Server
hunk ./clckwrks/Clckwrks/Plugin.hs 19
-import Web.Routes                  hiding (nestURL)
hunk ./clckwrks/Clckwrks/Plugin.hs 112
-    do (Just clckShowFn) <- getPluginRouteFn plugins "clck"
---       evalClckT defaultAdminMenu clckShowFn
---       addPreProc plugins "clck" (clckPreProcessor clckShowFn)
-       addHandler (plugins :: ClckPlugins) "clck" (clckHandler clckShowFn)
+    do (Just clckShowFn) <- getPluginRouteFn plugins (pluginName clckPlugin)
+       addPreProc plugins (pageCmd clckShowFn)
+       addHandler plugins (pluginName clckPlugin) (clckHandler clckShowFn)