[commit work-in-progress to split cms/blog code into clckwrks-plugin-page
Jeremy Shaw <jeremy@seereason.com>**20130125015352
 Ignore-this: 7924dc8cfb070627ed528a3c8c1d2f84
] adddir ./clckwrks-plugin-page
adddir ./clckwrks-plugin-page/Clckwrks
adddir ./clckwrks-plugin-page/Clckwrks/Page
adddir ./clckwrks-plugin-page/Clckwrks/Page/Admin
hunk ./clckwrks/Clckwrks/Page/API.hs 1
-{-# LANGUAGE FlexibleContexts, RecordWildCards #-}
-{-# OPTIONS_GHC -F -pgmFtrhsx #-}
-module Clckwrks.Page.API
-    ( PageId(..)
-    , getPage
-    , getPageId
-    , getPageTitle
-    , getPageTitleSlug
-    , getPageContent
-    , getPagesSummary
-    , getPageSummary
-    , getPageMenu
-    , getPosts
-    , extractExcerpt
-    , getBlogTitle
-    , googleAnalytics
-    ) where
-
-import Clckwrks.Acid
-import Clckwrks.Monad
-import Clckwrks.Page.Acid
-import Clckwrks.URL
-import Control.Applicative
-import Control.Monad.State
-import Control.Monad.Trans (MonadIO)
-import Data.Text (Text, empty)
-import qualified Data.Text as Text
-import Clckwrks.Page.Types (toSlug)
-import Happstack.Server
-import HSP hiding (escape)
-import HSP.Google.Analytics (analyticsAsync)
-import Text.HTML.TagSoup
-
-getPage :: Clck url Page
-getPage =
-    do ClckState{..} <- get
-       mPage <- query (PageById currentPage)
-       case mPage of
-         Nothing -> escape $ internalServerError $ toResponse ("getPage: invalid PageId " ++ show (unPageId currentPage))
-         (Just p) -> return p
-
-getPageId :: Clck url PageId
-getPageId = currentPage <$> get
-
-getPageTitle :: Clck url Text
-getPageTitle = pageTitle <$> getPage
-
-getPageTitleSlug :: Clck url (Text, Maybe Slug)
-getPageTitleSlug =
-    do p <- getPage
-       return (pageTitle p, pageSlug p)
-
-getPageContent :: Clck url Content
-getPageContent =
-    do mrkup <- pageSrc <$> getPage
-       markupToContent mrkup
-
-getPagesSummary :: Clck url [(PageId, Text, Maybe Slug)]
-getPagesSummary = query PagesSummary
-
-getPageMenu :: GenXML (Clck ClckURL)
-getPageMenu =
-    do ps <- query PagesSummary
-       case ps of
-         [] -> <div>No pages found.</div>
-         _ -> <ul class="page-menu">
-                <% mapM (\(pid, ttl, slug) -> <li><a href=(ViewPageSlug pid (toSlug ttl slug)) title=ttl><% ttl %></a></li>) ps %>
-              </ul>
-
-getPageSummary :: PageId -> Clck url Content
-getPageSummary pid =
-    do mPage <- query (PageById pid)
-       case mPage of
-         Nothing ->
-             return $ PlainText $ Text.pack $ "Invalid PageId " ++ (show $ unPageId pid)
-         (Just pge) ->
-             extractExcerpt pge
-
-getBlogTitle :: Clck url Text
-getBlogTitle = query GetBlogTitle
-
-extractExcerpt :: (MonadIO m, Functor m, Happstack m) =>
-                  Page
-               -> ClckT url m Content
-extractExcerpt Page{..} =
-             case pageExcerpt of
-               (Just excerpt) ->
-                   markupToContent excerpt
-               Nothing ->
-                   do c <- markupToContent pageSrc
-                      case c of
-                        (TrustedHtml html) ->
-                            let tags = parseTags html
-                                paragraphs = sections (~== "<p>") tags
-                                paragraph = case paragraphs of
-                                              [] -> Text.pack "no summary available."
-                                              (p:ps) -> renderTags $ takeThrough (not . isTagCloseName (Text.pack "p")) $ filter (not . isTagOpenName (Text.pack "img")) p
-                            in return (TrustedHtml paragraph)
-                        (PlainText text) ->
-                               return (PlainText text)
-
-takeThrough :: (a -> Bool) -> [a] -> [a]
-takeThrough _ [] = []
-takeThrough f (p:ps)
-    | f p = p : takeThrough f ps
-    | otherwise = []
-
--- | get all posts, sorted reverse cronological
-getPosts :: XMLGenT (Clck url) [Page]
-getPosts = query AllPosts
-
--- | create a google analytics tracking code block
---
--- This will under two different conditions:
---
---  * the 'enableAnalytics' field in 'ClckState' is 'False'
---
---  * the 'uacct' field in 'PageState' is 'Nothing'
-googleAnalytics :: XMLGenT (Clck url) XML
-googleAnalytics =
-    do enabled <- getEnableAnalytics
-       case enabled of
-         False -> return $ cdata ""
-         True ->
-             do muacct <- query GetUACCT
-                case muacct of
-                  Nothing -> return $ cdata ""
-                  (Just uacct) ->
-                      analyticsAsync uacct
rmfile ./clckwrks/Clckwrks/Page/API.hs
hunk ./clckwrks/Clckwrks/Page/Acid.hs 1
-{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies, RecordWildCards, OverloadedStrings #-}
-module Clckwrks.Page.Acid
-    ( module Clckwrks.Page.Types
-      -- * state
-    , PageState
-    , initialPageState
-      -- * events
-    , NewPage(..)
-    , PageById(..)
-    , GetPageTitle(..)
-    , IsPublishedPage(..)
-    , PagesSummary(..)
-    , UpdatePage(..)
-    , AllPosts(..)
-    , GetFeedConfig(..)
-    , SetFeedConfig(..)
-    , GetBlogTitle(..)
-    , GetUACCT(..)
-    , SetUACCT(..)
-    ) where
-
-import Clckwrks.Page.Types  (Markup(..), PublishStatus(..), PreProcessor(..), PageId(..), PageKind(..), Page(..), Pages(..), FeedConfig(..), Slug(..), initialFeedConfig, slugify)
-import Clckwrks.Types       (Trust(..))
-import Control.Applicative  ((<$>))
-import Control.Monad.Reader (ask)
-import Control.Monad.State  (get, modify, put)
-import Control.Monad.Trans  (liftIO)
-import Data.Acid            (AcidState, Query, Update, makeAcidic)
-import Data.Data            (Data, Typeable)
-import Data.IxSet           (Indexable, IxSet, (@=), Proxy(..), empty, fromList, getOne, ixSet, ixFun, insert, toList, toDescList, updateIx)
-import Data.Maybe           (fromJust)
-import Data.SafeCopy        (Migrate(..), base, deriveSafeCopy, extension)
-import Data.String          (fromString)
-import Data.Text            (Text)
-import Data.Time.Clock      (UTCTime, getCurrentTime)
-import Data.Time.Clock.POSIX(posixSecondsToUTCTime)
-import qualified Data.Text  as Text
-import           Data.UUID  (UUID)
-import qualified Data.UUID  as UUID
-import Happstack.Auth       (UserId(..))
-import HSP.Google.Analytics (UACCT)
-
-$(deriveSafeCopy 0 'base ''UACCT)
-
-data PageState_001  = PageState_001
-    { nextPageId_001 :: PageId
-    , pages_001      :: IxSet Page
-    }
-    deriving (Eq, Read, Show, Data, Typeable)
-$(deriveSafeCopy 1 'base ''PageState_001)
-
-data PageState_002  = PageState_002
-    { nextPageId_002 :: PageId
-    , pages_002      :: IxSet Page
-    , feedConfig_002 :: FeedConfig
-    }
-    deriving (Eq, Read, Show, Data, Typeable)
-$(deriveSafeCopy 2 'extension ''PageState_002)
-
-instance Migrate PageState_002 where
-    type MigrateFrom PageState_002 = PageState_001
-    migrate (PageState_001 npi pgs) =
-        PageState_002 npi pgs (FeedConfig { feedUUID       = fromJust $ UUID.fromString "fa6cf090-84d7-11e1-8001-0021cc712949"
-                                          , feedTitle      = fromString "Untitled Feed"
-                                          , feedLink       = fromString ""
-                                          , feedAuthorName = fromString "Anonymous"
-                                          })
-
-data PageState  = PageState
-    { nextPageId :: PageId
-    , pages      :: IxSet Page
-    , feedConfig :: FeedConfig
-    , uacct      :: Maybe UACCT
-    }
-    deriving (Eq, Read, Show, Data, Typeable)
-$(deriveSafeCopy 3 'extension ''PageState)
-
-instance Migrate PageState where
-    type MigrateFrom PageState = PageState_002
-    migrate (PageState_002 npi pgs fc) =
-        PageState npi pgs fc Nothing
-
-initialPageState :: IO PageState
-initialPageState =
-    do fc <- initialFeedConfig
-       return $ PageState { nextPageId = PageId 2
-                          , pages = fromList [ Page { pageId        = PageId 1
-                                                    , pageAuthor    = UserId 1
-                                                    , pageTitle     = "This title rocks!"
-                                                    , pageSlug      = Just $ slugify "This title rocks!"
-                                                    , pageSrc       = Markup { preProcessors = [ Markdown ]
-                                                                             , trust         = Trusted
-                                                                             , markup        = "This is the body!"
-                                                                             }
-                                                    , pageExcerpt   = Nothing
-                                                    , pageDate      = posixSecondsToUTCTime 1334089928
-                                                    , pageUpdated   = posixSecondsToUTCTime 1334089928
-                                                    , pageStatus    = Published
-                                                    , pageKind      = PlainPage
-                                                    , pageUUID      = fromJust $ UUID.fromString "c306fe3a-8346-11e1-8001-0021cc712949"
-                                                    }
-                                             ]
-                          , feedConfig = fc
-                          , uacct = Nothing
-                          }
-
-pageById :: PageId -> Query PageState (Maybe Page)
-pageById pid =
-    do pgs <- pages <$> ask
-       return $ getOne $ pgs @= pid
-
--- | get the 'pageTitle' for 'PageId'
-getPageTitle :: PageId -> Query PageState (Maybe (Text, Maybe Slug))
-getPageTitle pid =
-    do mPage <- pageById pid
-       case mPage of
-         Nothing     -> return $ Nothing
-         (Just page) -> return $ Just (pageTitle page, pageSlug page)
-
--- | check if the 'PageId' corresponds to a published 'PageId'
-isPublishedPage :: PageId -> Query PageState Bool
-isPublishedPage pid =
-    do pgs <- pages <$> ask
-       case getOne $ pgs @= pid of
-         Nothing     -> return False
-         (Just page) -> return $ pageStatus page == Published
-
-pagesSummary :: Query PageState [(PageId, Text, Maybe Slug)]
-pagesSummary =
-    do pgs <- pages <$> ask
-       return $ map (\page -> (pageId page, pageTitle page, pageSlug page)) (toList pgs)
-
-updatePage :: Page -> Update PageState (Maybe String)
-updatePage page =
-    do ps@PageState{..} <- get
-       case getOne $ pages @= (pageId page) of
-         Nothing  -> return $ Just $ "updatePage: Invalid PageId " ++ show (unPageId $ pageId page)
-         (Just _) ->
-             do put $ ps { pages = updateIx (pageId page) page pages }
-                return Nothing
-
-newPage :: PageKind -> UserId -> UUID -> UTCTime -> Update PageState Page
-newPage pk uid uuid now =
-    do ps@PageState{..} <- get
-       let page = Page { pageId      = nextPageId
-                       , pageAuthor  = uid
-                       , pageTitle   = "Untitled"
-                       , pageSlug    = Nothing
-                       , pageSrc     = Markup { preProcessors = [ Markdown ]
-                                              , trust         = Trusted
-                                              , markup        = Text.empty
-                                              }
-                       , pageExcerpt = Nothing
-                       , pageDate    = now
-                       , pageUpdated = now
-                       , pageStatus  = Draft
-                       , pageKind    = pk
-                       , pageUUID    = uuid
-                       }
-       put $ ps { nextPageId = PageId $ succ $ unPageId nextPageId
-                , pages      = insert page pages
-                }
-       return page
-
-getFeedConfig :: Query PageState FeedConfig
-getFeedConfig =
-    do PageState{..} <- ask
-       return feedConfig
-
-getBlogTitle :: Query PageState Text
-getBlogTitle =
-    do PageState{..} <- ask
-       return (feedTitle feedConfig)
-
-setFeedConfig :: FeedConfig -> Update PageState ()
-setFeedConfig fc =
-    do ps <- get
-       put $ ps { feedConfig = fc }
-
--- | get all 'Published' posts, sorted reverse cronological
-allPosts :: Query PageState [Page]
-allPosts =
-    do pgs <- pages <$> ask
-       return $ toDescList (Proxy :: Proxy UTCTime) (pgs @= Post @= Published)
-
--- | get the 'UACCT' for Google Analytics
-getUACCT :: Query PageState (Maybe UACCT)
-getUACCT = uacct <$> ask
-
--- | set the 'UACCT' for Google Analytics
-setUACCT :: Maybe UACCT -> Update PageState ()
-setUACCT mua = modify $ \ps -> ps { uacct = mua }
-
-$(makeAcidic ''PageState
-  [ 'newPage
-  , 'pageById
-  , 'getPageTitle
-  , 'isPublishedPage
-  , 'pagesSummary
-  , 'updatePage
-  , 'allPosts
-  , 'getFeedConfig
-  , 'setFeedConfig
-  , 'getBlogTitle
-  , 'getUACCT
-  , 'setUACCT
-  ])
rmfile ./clckwrks/Clckwrks/Page/Acid.hs
hunk ./clckwrks/Clckwrks/Page/Atom.hs 1
-{-# LANGUAGE RecordWildCards #-}
-{-# OPTIONS_GHC -F -pgmFtrhsx #-}
-module Clckwrks.Page.Atom where
-
-import Control.Monad.Trans (liftIO)
-import Clckwrks.Monad
-import Clckwrks.Page.Acid
-import Clckwrks.Page.Types
-import Clckwrks.ProfileData.Acid
-import Clckwrks.URL
-import qualified Data.ByteString.Lazy.UTF8 as UTF8
-import Data.Maybe            (fromMaybe)
-import Data.String           (fromString)
-import Data.Text             (Text, pack)
-import qualified Data.Text   as Text
-import Data.Time
-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
-import Data.Time.Format      (formatTime)
-import Data.UUID             (toString)
-import Happstack.Server      (Response, ok, toResponseBS)
-import HSP
-import HSP.XML               (renderXML)
-import System.Locale         (defaultTimeLocale)
-
-atom :: FeedConfig  -- ^ feed configuration
-     -> [Page]      -- ^ pages to publish in feed
-     -> Clck ClckURL XML
-atom FeedConfig{..} pages =
-    unXMLGenT $ <feed xmlns="http://www.w3.org/2005/Atom">
-                 <title><% feedTitle %></title>
-                 <link type="text/html" href=Blog />
-                 <link rel="self" type="application/atom+xml" href=AtomFeed />
-                 <author>
-                  <name><% feedAuthorName %></name>
-                 </author>
-                 <updated><% atomDate $ mostRecentUpdate pages %></updated>
-                 <id><% "urn:uuid:" ++ toString feedUUID %></id>
-                 <% mapM entry pages %>
-                </feed>
-
-mostRecentUpdate :: [Page]  -- ^ pages to consider
-                 -> UTCTime -- ^ most recent updated time
-mostRecentUpdate []    = posixSecondsToUTCTime 0
-mostRecentUpdate pages =
-    maximum $ map pageUpdated pages
-
-entry :: Page
-      -> Clck ClckURL XML
-entry Page{..} =
-     unXMLGenT $ <entry>
-                   <title><% pageTitle %></title>
-                   <link href=(ViewPageSlug pageId (toSlug pageTitle pageSlug)) />
-                   <id><% "urn:uuid:" ++ toString pageUUID %></id>
-                   <% author %>
-                   <updated><% atomDate pageUpdated %></updated>
-                   <% atomContent pageSrc %>
-                 </entry>
-    where
-      author :: XMLGenT (Clck ClckURL) XML
-      author =
-          do mu <- query $ UsernameForId pageAuthor
-             case mu of
-               Nothing -> return $ cdata ""
-               (Just n)
-                   | Text.null n ->
-                       return $ cdata ""
-                   | otherwise ->
-                       <author>
-                        <name><% n %></name>
-                       </author>
-
-atomDate :: UTCTime -> String
-atomDate time =
-    formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" time
-
-atomContent :: Markup -> Clck ClckURL XML
-atomContent markup =
-    do c <- markupToContent markup
-       case c of
-         (PlainText txt) ->
-              unXMLGenT $ <content type="text"><% txt %></content>
-         (TrustedHtml html) ->
-              unXMLGenT $ <content type="html"><% html %></content>
-
-handleAtomFeed :: Clck ClckURL Response
-handleAtomFeed =
-    do ps <- query AllPosts
-       feedConfig <- query GetFeedConfig
-       xml <- atom feedConfig ps
-       ok $ toResponseBS (fromString "application/atom+xml;charset=utf-8") (UTF8.fromString $ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n" ++ renderXML xml)
rmfile ./clckwrks/Clckwrks/Page/Atom.hs
hunk ./clckwrks/Clckwrks/Page/PreProcess.hs 1
-{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
-{-# OPTIONS_GHC -F -pgmFtrhsx #-}
-module Clckwrks.Page.PreProcess where
-
-import Control.Monad.Trans (MonadIO(..))
-import Control.Applicative ((<*>), (*>), (<$>), (<|>), optional)
-import Clckwrks.Monad (ClckT, ClckState, transform, query, segments)
-import Clckwrks.Page.Acid (GetPageTitle(..))
-import Clckwrks.URL   (ClckURL(ViewPageSlug))
-import Clckwrks.Page.Types (PageId(..), slugify, toSlug)
-import Data.Attoparsec.Text.Lazy        (Parser, Result(..), anyChar, char, choice, decimal, parse, skipMany, space, stringCI, skipMany, try)
-import Data.Attoparsec.Combinator (many1, manyTill, skipMany)
-import Data.String (fromString)
-import           Data.Text (Text, pack)
-import qualified Data.Text.Lazy         as TL
-import           Data.Text.Lazy.Builder (Builder)
-import qualified Data.Text.Lazy.Builder as B
-import HSP
-import HSP.HTML (renderAsHTML)
-import Web.Routes (showURL)
-
--- TODO: move to reusable module
-parseAttr :: Text -> Parser ()
-parseAttr name =
-    do skipMany space
-       stringCI name
-       skipMany space
-       char '='
-       skipMany space
-
-qchar :: Parser Char
-qchar = (char '\\' *> anyChar) <|> anyChar
-
-text :: Parser Text
-text = pack <$> many1 qchar
-
-qtext :: Parser Text
-qtext = pack <$> (char '"' *> manyTill qchar (try $ char '"'))
-
-data PageCmd
-    = LinkPage PageId (Maybe Text)
-      deriving (Eq, Ord, Show)
-
-pageId :: Parser PageCmd
-pageId = LinkPage <$> (parseAttr (fromString "id") *> (PageId <$> decimal)) <*> (optional $ parseAttr (fromString "title") *> qtext)
-
-parseCmd :: Parser PageCmd
-parseCmd = pageId
-
-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
-
-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
rmfile ./clckwrks/Clckwrks/Page/PreProcess.hs
hunk ./clckwrks/Clckwrks/Page/Types.hs 1
-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TemplateHaskell, TypeFamilies #-}
-module Clckwrks.Page.Types where
-
-import Clckwrks.Markup.HsColour (hscolour)
-import Clckwrks.Markup.Markdown (markdown)
-import Clckwrks.Types           (Trust(..))
-import Control.Applicative      ((<$>), optional)
-import Control.Monad.Trans      (MonadIO(liftIO))
-import Data.Aeson               (ToJSON(..), FromJSON(..))
-import Data.Char                (ord, toLower, isAlphaNum)
-import Data.Data                (Data, Typeable)
-import Data.Maybe               (fromMaybe)
-import Data.IxSet               (Indexable(..), IxSet, ixFun, ixSet)
-import Data.SafeCopy            (Migrate(..), base, deriveSafeCopy, extension)
-import Data.String              (fromString)
-import Data.Text                (Text)
-import qualified Data.Text      as Text
-import Data.Time                (UTCTime)
-import Data.Time.Clock.POSIX    (posixSecondsToUTCTime)
-import Data.UUID                (UUID)
-import Data.UUID.V5             (generateNamed, namespaceOID)
-import Happstack.Auth           (UserId(..))
-import Web.Routes               (PathInfo(..), anySegment)
-import System.Random            (randomIO)
-
-
-$(deriveSafeCopy 0 'base ''UUID)
-
-instance PathInfo PageId where
-    toPathSegments (PageId i) = toPathSegments i
-    fromPathSegments = PageId <$> fromPathSegments
-
-newtype PageId = PageId { unPageId :: Integer }
-    deriving (Eq, Ord, Show, Read, Data, Typeable)
-$(deriveSafeCopy 1 'base ''PageId)
-
-instance ToJSON PageId where
-    toJSON (PageId i) = toJSON i
-instance FromJSON PageId where
-    parseJSON n = PageId <$> parseJSON n
-
-data PreProcessor
-    = HsColour
-    | Markdown
-      deriving (Eq, Ord, Read, Show, Data, Typeable)
-$(deriveSafeCopy 1 'base ''PreProcessor)
-
--- $(deriveJSON id ''PreProcessor)
-
-runPreProcessors :: (MonadIO m) => [PreProcessor] -> Trust -> Text -> m (Either Text Text)
-runPreProcessors [] _ txt = return (Right txt)
-runPreProcessors (p:ps) trust txt =
-    do e <- runPreProcessor p trust txt
-       case e of
-         (Left e) -> return (Left e)
-         (Right txt') -> runPreProcessors ps trust txt'
-
-runPreProcessor :: (MonadIO m) => PreProcessor -> Trust -> Text -> m (Either Text Text)
-runPreProcessor pproc trust txt =
-    do let f = case pproc of
-                 Markdown -> markdown Nothing trust
-                 HsColour -> hscolour Nothing
-       f txt
-
-data Markup_001
-    = Markup_001 { preProcessors_001 :: [PreProcessor]
-                 , markup_001 :: Text
-                 }
-      deriving (Eq, Ord, Read, Show, Data, Typeable)
-$(deriveSafeCopy 1 'base ''Markup_001)
-
-data Markup
-    = Markup { preProcessors :: [PreProcessor]
-             , markup        :: Text
-             , trust         :: Trust
-             }
-      deriving (Eq, Ord, Read, Show, Data, Typeable)
-$(deriveSafeCopy 2 'extension ''Markup)
-
-instance Migrate Markup where
-    type MigrateFrom Markup = Markup_001
-    migrate (Markup_001 pp mu) = Markup pp mu Trusted
-
-data PublishStatus
-    = Draft
-    | Revoked
-    | Published
-    | Scheduled
-      deriving (Eq, Ord, Read, Show, Data, Typeable)
-$(deriveSafeCopy 1 'base ''PublishStatus)
-
-data PageKind
-    = PlainPage
-    | Post
-      deriving (Eq, Ord, Read, Show, Data, Typeable)
-$(deriveSafeCopy 1 'base ''PageKind)
-
-data Page_001
-    = Page_001 { pageId_001        :: PageId
-               , pageTitle_001     :: Text
-               , pageSrc_001       :: Markup
-               , pageExcerpt_001   :: Maybe Markup
-               , pageDate_001      :: Maybe UTCTime
-               , pageStatus_001    :: PublishStatus
-               , pageKind_001      :: PageKind
-               }
-      deriving (Eq, Ord, Read, Show, Data, Typeable)
-$(deriveSafeCopy 1 'base ''Page_001)
-
-data Page_002
-    = Page_002 { pageId_002        :: PageId
-               , pageAuthor_002    :: UserId
-               , pageTitle_002     :: Text
-               , pageSrc_002       :: Markup
-               , pageExcerpt_002   :: Maybe Markup
-               , pageDate_002      :: UTCTime
-               , pageUpdated_002   :: UTCTime
-               , pageStatus_002    :: PublishStatus
-               , pageKind_002      :: PageKind
-               , pageUUID_002      :: UUID
-               }
-      deriving (Eq, Ord, Read, Show, Data, Typeable)
-$(deriveSafeCopy 2 'extension ''Page_002)
-
-instance Migrate Page_002 where
-    type MigrateFrom Page_002 = Page_001
-    migrate (Page_001 pi pt ps pe pd pst pk) =
-        (Page_002 pi (UserId 1) pt ps pe (fromMaybe epoch pd) (fromMaybe epoch pd) pst pk $ generateNamed namespaceOID (map (fromIntegral . ord) (show pi ++ show ps)))
-            where
-              epoch = posixSecondsToUTCTime 0
-
-newtype Slug = Slug { unSlug :: Text }
-    deriving (Eq, Ord, Data, Typeable, Read, Show)
-$(deriveSafeCopy 0 'base ''Slug)
-
-instance PathInfo Slug where
-    toPathSegments (Slug txt) = [txt]
-    fromPathSegments = Slug <$> anySegment
-
--- NOTE: this instance will cause faulty behavior if the Maybe Slug is not at the end of the URL
-instance PathInfo (Maybe Slug) where
-    toPathSegments (Just slug) = toPathSegments slug
-    fromPathSegments = optional $ fromPathSegments
-
-slugify :: Text -> Slug
-slugify txt = Slug $ Text.dropWhileEnd (=='-') $ Text.map (\c -> if isAlphaNum c then (toLower c) else '-') txt
-
-toSlug :: Text -> Maybe Slug -> Slug
-toSlug txt slug = fromMaybe (slugify txt) slug
-
-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
-           }
-      deriving (Eq, Ord, Read, Show, Data, Typeable)
-$(deriveSafeCopy 3 'extension ''Page)
-
-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)
-
-instance Indexable Page where
-    empty = ixSet [ ixFun ((:[]) . pageId)
-                  , ixFun ((:[]) . pageDate)
-                  , ixFun ((:[]) . pageKind)
-                  , ixFun ((:[]) . pageDate)
-                  , ixFun ((:[]) . pageStatus)
-                  ]
-
-type Pages = IxSet Page
-
-data FeedConfig = FeedConfig
-    { feedUUID       :: UUID -- ^ UUID which identifies this feed. Should probably never change
---    , feedCategory :: Set Text
-    , feedTitle      :: Text
-    , feedLink       :: Text
-    , feedAuthorName :: Text
-    }
-    deriving (Eq, Ord, Read, Show, Data, Typeable)
-$(deriveSafeCopy 0 'base ''FeedConfig)
-
-initialFeedConfig :: IO FeedConfig
-initialFeedConfig =
-    do uuid <- randomIO
-       return $ FeedConfig { feedUUID       = uuid
-                           , feedTitle      = fromString "Untitled Feed"
-                           , feedLink       = fromString ""
-                           , feedAuthorName = fromString "Anonymous"
-                           }
rmfile ./clckwrks/Clckwrks/Page/Types.hs
rmdir ./clckwrks/Clckwrks/Page
hunk ./clckwrks-plugin-bugs/Clckwrks/Bugs/Route.hs 21
-checkAuth :: BugsURL
+checkAuth : BugsURL
addfile ./clckwrks-plugin-page/Clckwrks/Page/API.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/API.hs 1
+{-# LANGUAGE FlexibleContexts, RecordWildCards #-}
+{-# OPTIONS_GHC -F -pgmFtrhsx #-}
+module Clckwrks.Page.API
+    ( PageId(..)
+    , getPage
+    , getPageId
+    , getPageTitle
+    , getPageTitleSlug
+    , getPageContent
+    , getPagesSummary
+    , getPageSummary
+    , getPageMenu
+    , getPosts
+    , extractExcerpt
+    , getBlogTitle
+    , googleAnalytics
+    ) where
+
+import Clckwrks.Monad       ( Clck, ClckT(..), ClckState(..), Content(..)
+                            , getEnableAnalytics, query, update
+                            )
+import Clckwrks.Page.Acid   ( PagesSummary(..), Page(..), PageById(..), PageId(..)
+                            , Slug(..), GetUACCT(..), AllPosts(..), GetBlogTitle(..))
+import Clckwrks.Page.Monad  ( markupToContent )
+import Clckwrks.URL         (ClckURL(..))
+import Control.Applicative  ((<$>))
+import Control.Monad.State  (get)
+import Control.Monad.Trans  (MonadIO)
+import Data.Text            (Text)
+import qualified Data.Text  as Text
+import Clckwrks.Page.Types  (toSlug)
+import Happstack.Server     (Happstack, escape, internalServerError, toResponse)
+import HSP                  hiding (escape)
+import HSP.Google.Analytics (analyticsAsync)
+import Text.HTML.TagSoup    ( (~==), isTagCloseName, isTagOpenName, parseTags
+                            , renderTags, sections)
+
+getPage :: Clck url Page
+getPage =
+    do ClckState{..} <- get
+       mPage <- query (PageById currentPage)
+       case mPage of
+         Nothing -> escape $ internalServerError $ toResponse ("getPage: invalid PageId " ++ show (unPageId currentPage))
+         (Just p) -> return p
+
+getPageId :: Clck url PageId
+getPageId = currentPage <$> get
+
+getPageTitle :: Clck url Text
+getPageTitle = pageTitle <$> getPage
+
+getPageTitleSlug :: Clck url (Text, Maybe Slug)
+getPageTitleSlug =
+    do p <- getPage
+       return (pageTitle p, pageSlug p)
+
+getPageContent :: Clck url Content
+getPageContent =
+    do mrkup <- pageSrc <$> getPage
+       markupToContent mrkup
+
+getPagesSummary :: Clck url [(PageId, Text, Maybe Slug)]
+getPagesSummary = query PagesSummary
+
+getPageMenu :: GenXML (Clck ClckURL)
+getPageMenu =
+    do ps <- query PagesSummary
+       case ps of
+         [] -> <div>No pages found.</div>
+         _ -> <ul class="page-menu">
+                <% mapM (\(pid, ttl, slug) -> <li><a href=(ViewPageSlug pid (toSlug ttl slug)) title=ttl><% ttl %></a></li>) ps %>
+              </ul>
+
+getPageSummary :: PageId -> Clck url Content
+getPageSummary pid =
+    do mPage <- query (PageById pid)
+       case mPage of
+         Nothing ->
+             return $ PlainText $ Text.pack $ "Invalid PageId " ++ (show $ unPageId pid)
+         (Just pge) ->
+             extractExcerpt pge
+
+getBlogTitle :: Clck url Text
+getBlogTitle = query GetBlogTitle
+
+extractExcerpt :: (MonadIO m, Functor m, Happstack m) =>
+                  Page
+               -> ClckT url m Content
+extractExcerpt Page{..} =
+             case pageExcerpt of
+               (Just excerpt) ->
+                   markupToContent excerpt
+               Nothing ->
+                   do c <- markupToContent pageSrc
+                      case c of
+                        (TrustedHtml html) ->
+                            let tags = parseTags html
+                                paragraphs = sections (~== "<p>") tags
+                                paragraph = case paragraphs of
+                                              [] -> Text.pack "no summary available."
+                                              (p:ps) -> renderTags $ takeThrough (not . isTagCloseName (Text.pack "p")) $ filter (not . isTagOpenName (Text.pack "img")) p
+                            in return (TrustedHtml paragraph)
+                        (PlainText text) ->
+                               return (PlainText text)
+
+takeThrough :: (a -> Bool) -> [a] -> [a]
+takeThrough _ [] = []
+takeThrough f (p:ps)
+    | f p = p : takeThrough f ps
+    | otherwise = []
+
+-- | get all posts, sorted reverse cronological
+getPosts :: XMLGenT (Clck url) [Page]
+getPosts = query AllPosts
+
+-- | create a google analytics tracking code block
+--
+-- This will under two different conditions:
+--
+--  * the 'enableAnalytics' field in 'ClckState' is 'False'
+--
+--  * the 'uacct' field in 'PageState' is 'Nothing'
+googleAnalytics :: XMLGenT (Clck url) XML
+googleAnalytics =
+    do enabled <- getEnableAnalytics
+       case enabled of
+         False -> return $ cdata ""
+         True ->
+             do muacct <- query GetUACCT
+                case muacct of
+                  Nothing -> return $ cdata ""
+                  (Just uacct) ->
+                      analyticsAsync uacct
addfile ./clckwrks-plugin-page/Clckwrks/Page/Acid.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/Acid.hs 1
+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies, RecordWildCards, OverloadedStrings #-}
+module Clckwrks.Page.Acid
+    ( module Clckwrks.Page.Types
+      -- * state
+    , PageState
+    , initialPageState
+      -- * events
+    , NewPage(..)
+    , PageById(..)
+    , GetPageTitle(..)
+    , IsPublishedPage(..)
+    , PagesSummary(..)
+    , UpdatePage(..)
+    , AllPosts(..)
+    , GetFeedConfig(..)
+    , SetFeedConfig(..)
+    , GetBlogTitle(..)
+    , GetUACCT(..)
+    , SetUACCT(..)
+    ) where
+
+import Clckwrks.Page.Types  (Markup(..), PublishStatus(..), PreProcessor(..), PageId(..), PageKind(..), Page(..), Pages(..), FeedConfig(..), Slug(..), initialFeedConfig, slugify)
+import Clckwrks.Types       (Trust(..))
+import Control.Applicative  ((<$>))
+import Control.Monad.Reader (ask)
+import Control.Monad.State  (get, modify, put)
+import Control.Monad.Trans  (liftIO)
+import Data.Acid            (AcidState, Query, Update, makeAcidic)
+import Data.Data            (Data, Typeable)
+import Data.IxSet           (Indexable, IxSet, (@=), Proxy(..), empty, fromList, getOne, ixSet, ixFun, insert, toList, toDescList, updateIx)
+import Data.Maybe           (fromJust)
+import Data.SafeCopy        (Migrate(..), base, deriveSafeCopy, extension)
+import Data.String          (fromString)
+import Data.Text            (Text)
+import Data.Time.Clock      (UTCTime, getCurrentTime)
+import Data.Time.Clock.POSIX(posixSecondsToUTCTime)
+import qualified Data.Text  as Text
+import           Data.UUID  (UUID)
+import qualified Data.UUID  as UUID
+import Happstack.Auth       (UserId(..))
+import HSP.Google.Analytics (UACCT)
+
+$(deriveSafeCopy 0 'base ''UACCT)
+
+data PageState_001  = PageState_001
+    { nextPageId_001 :: PageId
+    , pages_001      :: IxSet Page
+    }
+    deriving (Eq, Read, Show, Data, Typeable)
+$(deriveSafeCopy 1 'base ''PageState_001)
+
+data PageState_002  = PageState_002
+    { nextPageId_002 :: PageId
+    , pages_002      :: IxSet Page
+    , feedConfig_002 :: FeedConfig
+    }
+    deriving (Eq, Read, Show, Data, Typeable)
+$(deriveSafeCopy 2 'extension ''PageState_002)
+
+instance Migrate PageState_002 where
+    type MigrateFrom PageState_002 = PageState_001
+    migrate (PageState_001 npi pgs) =
+        PageState_002 npi pgs (FeedConfig { feedUUID       = fromJust $ UUID.fromString "fa6cf090-84d7-11e1-8001-0021cc712949"
+                                          , feedTitle      = fromString "Untitled Feed"
+                                          , feedLink       = fromString ""
+                                          , feedAuthorName = fromString "Anonymous"
+                                          })
+
+data PageState  = PageState
+    { nextPageId :: PageId
+    , pages      :: IxSet Page
+    , feedConfig :: FeedConfig
+    , uacct      :: Maybe UACCT
+    }
+    deriving (Eq, Read, Show, Data, Typeable)
+$(deriveSafeCopy 3 'extension ''PageState)
+
+instance Migrate PageState where
+    type MigrateFrom PageState = PageState_002
+    migrate (PageState_002 npi pgs fc) =
+        PageState npi pgs fc Nothing
+
+initialPageState :: IO PageState
+initialPageState =
+    do fc <- initialFeedConfig
+       return $ PageState { nextPageId = PageId 2
+                          , pages = fromList [ Page { pageId        = PageId 1
+                                                    , pageAuthor    = UserId 1
+                                                    , pageTitle     = "This title rocks!"
+                                                    , pageSlug      = Just $ slugify "This title rocks!"
+                                                    , pageSrc       = Markup { preProcessors = [ Markdown ]
+                                                                             , trust         = Trusted
+                                                                             , markup        = "This is the body!"
+                                                                             }
+                                                    , pageExcerpt   = Nothing
+                                                    , pageDate      = posixSecondsToUTCTime 1334089928
+                                                    , pageUpdated   = posixSecondsToUTCTime 1334089928
+                                                    , pageStatus    = Published
+                                                    , pageKind      = PlainPage
+                                                    , pageUUID      = fromJust $ UUID.fromString "c306fe3a-8346-11e1-8001-0021cc712949"
+                                                    }
+                                             ]
+                          , feedConfig = fc
+                          , uacct = Nothing
+                          }
+
+pageById :: PageId -> Query PageState (Maybe Page)
+pageById pid =
+    do pgs <- pages <$> ask
+       return $ getOne $ pgs @= pid
+
+-- | get the 'pageTitle' for 'PageId'
+getPageTitle :: PageId -> Query PageState (Maybe (Text, Maybe Slug))
+getPageTitle pid =
+    do mPage <- pageById pid
+       case mPage of
+         Nothing     -> return $ Nothing
+         (Just page) -> return $ Just (pageTitle page, pageSlug page)
+
+-- | check if the 'PageId' corresponds to a published 'PageId'
+isPublishedPage :: PageId -> Query PageState Bool
+isPublishedPage pid =
+    do pgs <- pages <$> ask
+       case getOne $ pgs @= pid of
+         Nothing     -> return False
+         (Just page) -> return $ pageStatus page == Published
+
+pagesSummary :: Query PageState [(PageId, Text, Maybe Slug)]
+pagesSummary =
+    do pgs <- pages <$> ask
+       return $ map (\page -> (pageId page, pageTitle page, pageSlug page)) (toList pgs)
+
+updatePage :: Page -> Update PageState (Maybe String)
+updatePage page =
+    do ps@PageState{..} <- get
+       case getOne $ pages @= (pageId page) of
+         Nothing  -> return $ Just $ "updatePage: Invalid PageId " ++ show (unPageId $ pageId page)
+         (Just _) ->
+             do put $ ps { pages = updateIx (pageId page) page pages }
+                return Nothing
+
+newPage :: PageKind -> UserId -> UUID -> UTCTime -> Update PageState Page
+newPage pk uid uuid now =
+    do ps@PageState{..} <- get
+       let page = Page { pageId      = nextPageId
+                       , pageAuthor  = uid
+                       , pageTitle   = "Untitled"
+                       , pageSlug    = Nothing
+                       , pageSrc     = Markup { preProcessors = [ Markdown ]
+                                              , trust         = Trusted
+                                              , markup        = Text.empty
+                                              }
+                       , pageExcerpt = Nothing
+                       , pageDate    = now
+                       , pageUpdated = now
+                       , pageStatus  = Draft
+                       , pageKind    = pk
+                       , pageUUID    = uuid
+                       }
+       put $ ps { nextPageId = PageId $ succ $ unPageId nextPageId
+                , pages      = insert page pages
+                }
+       return page
+
+getFeedConfig :: Query PageState FeedConfig
+getFeedConfig =
+    do PageState{..} <- ask
+       return feedConfig
+
+getBlogTitle :: Query PageState Text
+getBlogTitle =
+    do PageState{..} <- ask
+       return (feedTitle feedConfig)
+
+setFeedConfig :: FeedConfig -> Update PageState ()
+setFeedConfig fc =
+    do ps <- get
+       put $ ps { feedConfig = fc }
+
+-- | get all 'Published' posts, sorted reverse cronological
+allPosts :: Query PageState [Page]
+allPosts =
+    do pgs <- pages <$> ask
+       return $ toDescList (Proxy :: Proxy UTCTime) (pgs @= Post @= Published)
+
+-- | get the 'UACCT' for Google Analytics
+getUACCT :: Query PageState (Maybe UACCT)
+getUACCT = uacct <$> ask
+
+-- | set the 'UACCT' for Google Analytics
+setUACCT :: Maybe UACCT -> Update PageState ()
+setUACCT mua = modify $ \ps -> ps { uacct = mua }
+
+$(makeAcidic ''PageState
+  [ 'newPage
+  , 'pageById
+  , 'getPageTitle
+  , 'isPublishedPage
+  , 'pagesSummary
+  , 'updatePage
+  , 'allPosts
+  , 'getFeedConfig
+  , 'setFeedConfig
+  , 'getBlogTitle
+  , 'getUACCT
+  , 'setUACCT
+  ])
addfile ./clckwrks-plugin-page/Clckwrks/Page/Admin/EditFeedConfig.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/Admin/EditFeedConfig.hs 1
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -F -pgmFtrhsx #-}
+module Clckwrks.Page.Admin.EditFeedConfig where
+
+import Clckwrks                 (ClckURL(Admin), AdminURL(Console), query, update)
+import Clckwrks.Admin.Template  (template)
+import Clckwrks.Page.Acid       (GetFeedConfig(..), SetFeedConfig(..))
+import Clckwrks.Page.Monad      (PageConfig(pageClckURL), PageM, PageForm, PageFormError)
+import Clckwrks.Page.Types      (FeedConfig(..))
+import Clckwrks.Page.URL        (PageURL(..))
+import Control.Applicative      ((<$>), (<*), (<*>))
+import Control.Monad.Reader     (ask)
+import Data.Text                (Text, pack)
+import Happstack.Server         (Response, seeOther, toResponse)
+import HSP
+import Text.Reform
+import Text.Reform.Happstack
+import Text.Reform.HSP.Text
+import Web.Routes               (showURL)
+
+editFeedConfig :: PageURL -> PageM Response
+editFeedConfig here =
+    do feedConfig <- query $ GetFeedConfig
+       action <- showURL here
+       template "edit feed config" () $
+                  <%>
+                   <% reform (form action) "ep" updateFeedConfig Nothing (feedConfigForm feedConfig) %>
+                  </%>
+    where
+      updateFeedConfig :: FeedConfig -> PageM Response
+      updateFeedConfig fc =
+          do update (SetFeedConfig fc)
+             showURL <- pageClckURL <$> ask
+             seeOther (showURL (Admin Console) []) (toResponse ())
+
+feedConfigForm :: FeedConfig -> PageForm FeedConfig
+feedConfigForm fc@FeedConfig{..} =
+    fieldset $
+     ol $
+      ((,) <$> (li $ label "Feed Title:")          ++> (li $ inputText feedTitle)
+           <*> (li $ label "Default Author Name:") ++> (li $ inputText feedAuthorName)
+           <* inputSubmit (pack "update")
+      )
+     `transformEither` toFeedConfig
+    where
+      toFeedConfig :: (Text, Text) -> Either PageFormError FeedConfig
+      toFeedConfig (ttl, athr) =
+              Right $ fc { feedTitle      = ttl
+                         , feedAuthorName = athr
+                         }
addfile ./clckwrks-plugin-page/Clckwrks/Page/Admin/EditPage.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/Admin/EditPage.hs 1
+{-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -F -pgmFtrhsx #-}
+module Clckwrks.Page.Admin.EditPage
+    ( editPage
+    ) where
+
+import Control.Applicative ((<$>), (<*>), (<*))
+import Clckwrks
+import Clckwrks.Admin.Template (template)
+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 Data.Maybe              (isJust, maybe)
+import Data.Text               (Text, pack)
+import qualified Data.Text     as Text
+import Data.Time.Clock         (getCurrentTime)
+import Text.Reform             ((<++), (++>), transformEitherM)
+import Text.Reform.Happstack   (reform)
+import Text.Reform.HSP.Text    (form, inputCheckbox, inputText, label, inputSubmit, select, textarea, fieldset, ol, li, setAttrs)
+
+data AfterSaveAction
+    = EditSomeMore
+    | VisitPage
+    | ShowPreview
+
+editPage :: PageURL -> PageId -> PageM Response
+editPage here pid =
+    do mPage <- query $ PageById pid
+       case mPage of
+         Nothing -> notFound $ toResponse $ "Page not found: " ++ show (unPageId pid)
+         (Just page) ->
+             do action <- showURL here
+                template "edit page" () $
+                  <%>
+                   <% reform (form action) "ep" updatePage Nothing (pageFormlet page) %>
+                  </%>
+    where
+      updatePage :: (Page, AfterSaveAction) -> PageM Response
+      updatePage (page, afterSaveAction) =
+          do update (UpdatePage page)
+             case afterSaveAction of
+               EditSomeMore -> seeOtherURL (PageAdmin $ EditPage    (pageId page))
+               VisitPage    -> seeOtherURL (ViewPageSlug (pageId page) (toSlug (pageTitle page) (pageSlug page)))
+               ShowPreview  -> seeOtherURL (PageAdmin $ PreviewPage (pageId page))
+
+
+pageFormlet :: Page -> PageForm (Page, AfterSaveAction)
+pageFormlet page =
+    (fieldset $
+       ol $ (,,,,,,,)
+              <$> (li $ inputCheckbox hsColour <++ label "Highlight Haskell code with HsColour")
+              <*> ((li $ label "kind:")  ++> (li $ select [(PlainPage, "page"), (Post, "post")] (== (pageKind page))))
+              <*> ((li $ label "title:") ++> (li $ inputText (pageTitle page) `setAttrs` ("size" := "80") ))
+              <*> ((li $ label "slug (optional):") ++> (li $ inputText (maybe Text.empty unSlug $ pageSlug page) `setAttrs` ("size" := "80") ))
+              <*> ((li $ label "body:")  ++> (li $ textarea 80 25 (markup (pageSrc page))))
+              <*> inputSubmit (pack "save")
+              <*> inputSubmit (pack "preview")
+              <*> newPublishStatus (pageStatus page)
+    ) `transformEitherM` toPage
+    where
+      newPublishStatus :: PublishStatus -> PageForm (Maybe PublishStatus)
+      newPublishStatus Published = fmap (const Draft)     <$> inputSubmit (pack "save & unpublish")
+      newPublishStatus _         = fmap (const Published) <$> inputSubmit (pack "save & publish")
+      hsColour = HsColour `elem` (preProcessors $ pageSrc page)
+      toPage :: (MonadIO m) => (Bool, PageKind, Text, Text, Text, Maybe Text, Maybe Text, Maybe PublishStatus) -> m (Either PageFormError (Page, AfterSaveAction))
+      toPage (haskell, kind, ttl, slug, 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 ]
+                                             , trust = Trusted
+                                             , markup = bdy
+                                             }
+                      , pageExcerpt = Nothing
+                      , pageDate    = pageDate page
+                      , pageUpdated = now
+                      , pageStatus  = case mpagestatus of
+                                        (Just newStatus) -> newStatus
+                                        Nothing          -> pageStatus page
+                      , pageKind    = kind
+                      , pageUUID    = pageUUID page
+                      }
+               , if isJust mpreview
+                 then ShowPreview
+                 else case mpagestatus of
+                       (Just Published) -> VisitPage
+                       _                -> EditSomeMore
+               )
addfile ./clckwrks-plugin-page/Clckwrks/Page/Admin/NewPage.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/Admin/NewPage.hs 1
+{-# OPTIONS_GHC -F -pgmFtrhsx #-}
+module Clckwrks.Page.Admin.NewPage where
+
+import Clckwrks
+import Clckwrks.Page.Acid      as Acid
+import Clckwrks.Page.Monad     (PageM)
+import Clckwrks.Page.URL       as URL (PageURL(..), PageAdminURL(NewPage, NewPost, EditPage))
+import Clckwrks.Admin.Template (template)
+import Data.UUID               () -- instance Random UUID
+import Data.Time.Clock         (getCurrentTime)
+import System.Random           (randomIO)
+
+newPage :: PageKind -> PageM Response
+newPage pageKind =
+    do method GET
+       template "Create New Page/Post" () $
+         <%>
+          <form action=(PageAdmin URL.NewPage) method="POST" enctype="multipart/form-data">
+           <button type="submit">Create New Page</button>
+          </form>
+          <form action=(PageAdmin URL.NewPost) method="POST" enctype="multipart/form-data">
+           <button type="submit">Create New Post</button>
+          </form>
+         </%>
+
+    <|>
+    do method POST
+       uuid <- liftIO $ randomIO
+       now  <- liftIO $ getCurrentTime
+       muid <- getUserId
+       case muid of
+         Nothing -> escape $ internalServerError $ toResponse "Clcwrks.Admin.NewPage.newPage was unable to obtain the current UserId"
+         (Just uid) ->
+             do page <- update (Acid.NewPage pageKind uid uuid now)
+                seeOtherURL (PageAdmin $ EditPage (pageId page))
addfile ./clckwrks-plugin-page/Clckwrks/Page/Admin/Pages.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/Admin/Pages.hs 1
+{-# OPTIONS_GHC -F -pgmFtrhsx #-}
+module Clckwrks.Page.Admin.Pages where
+
+import Clckwrks.Monad          (query)
+import Clckwrks.Admin.Template (template)
+import Clckwrks.Page.Acid      (PagesSummary(..))
+import Clckwrks.Page.Monad     (PageM)
+import Clckwrks.Page.URL       (PageAdminURL(..), PageURL(..))
+import Clckwrks.Page.Types     (PageId, Slug(..))
+import Data.Text               (Text)
+import Happstack.Server        (Response)
+import HSP
+
+pages :: PageM Response
+pages =
+    do pages <- query PagesSummary
+       template "page list" () $ editList pages
+
+editList ::  [(PageId, Text, Maybe Slug)] -> GenChildList PageM
+editList [] = <%><p>There are currently no pages.</p></%>
+editList pgs =
+    <%>
+     <p>Edit Page</p>
+     <ul class="plain-list">
+      <% mapM editPageLI pgs %>
+     </ul>
+    </%>
+    where
+      editPageLI :: (PageId, Text, Maybe Slug) -> GenXML PageM
+      editPageLI (pid, ttl, _slug) =
+          <li><a href=(PageAdmin $ EditPage pid)><% ttl %></a></li>
addfile ./clckwrks-plugin-page/Clckwrks/Page/Admin/PreviewPage.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/Admin/PreviewPage.hs 1
+{-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -F -pgmFtrhsx #-}
+module Clckwrks.Page.Admin.PreviewPage
+    ( previewPage
+    ) where
+
+import Clckwrks
+import Clckwrks.Admin.Template   (template)
+import Clckwrks.ProfileData.Acid (HasRole(..))
+import Clckwrks.Page.Acid        (Page(..), PageId(..), PublishStatus(..), PageById(..))
+import Clckwrks.Page.Monad       (PageM, clckT2PageT, markupToContent)
+import Clckwrks.Unauthorized     ()
+import Control.Monad.State       (get)
+import qualified Data.Set        as Set
+import Web.Plugins.Core          (getTheme)
+
+previewPage :: PageId -> PageM Response
+previewPage pid =
+    do mPage <- query $ PageById pid
+       case mPage of
+         Nothing -> do notFound ()
+                       template "Page not found" () $ <% "Page not found: " ++ show (unPageId pid) %>
+         (Just page) ->
+           do muid <- getUserId
+              authorized <-
+                  case muid of
+                    Nothing    -> return False
+                    (Just uid) -> query $ HasRole uid (Set.singleton Administrator)
+              if authorized
+                 then do cs <- get
+                         (Just page) <- query (PageById pid)
+                         let ttl = pageTitle page
+                         bdy <- markupToContent (pageSrc page)
+                         clckT2PageT $ themeTemplate (plugins cs) ttl () bdy
+                 else unauthorized (toResponse $ "Sorry, you need Administrator access to view this page.")
addfile ./clckwrks-plugin-page/Clckwrks/Page/Atom.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/Atom.hs 1
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -F -pgmFtrhsx #-}
+module Clckwrks.Page.Atom where
+
+import Control.Monad.Trans (liftIO)
+import Clckwrks.Monad         (Clck, Content(..), query, withAbs)
+import Clckwrks.Page.Acid
+import Clckwrks.Page.Monad    (PageM, markupToContent)
+import Clckwrks.Page.Types
+import Clckwrks.ProfileData.Acid
+import Clckwrks.Page.URL
+import qualified Data.ByteString.Lazy.UTF8 as UTF8
+import Data.Maybe            (fromMaybe)
+import Data.String           (fromString)
+import Data.Text             (Text, pack)
+import qualified Data.Text   as Text
+import Data.Time
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
+import Data.Time.Format      (formatTime)
+import Data.UUID             (toString)
+import Happstack.Server      (Happstack, Response, ok, toResponseBS)
+import HSP
+import HSP.XML               (renderXML)
+import System.Locale         (defaultTimeLocale)
+import Web.Routes            (showURL)
+
+atom :: FeedConfig  -- ^ feed configuration
+     -> [Page]      -- ^ pages to publish in feed
+     -> PageM XML
+atom FeedConfig{..} pages =
+    do blogURL <- withAbs $ showURL Blog
+       atomURL <- withAbs $ showURL AtomFeed
+       unXMLGenT $ <feed xmlns="http://www.w3.org/2005/Atom">
+                    <title><% feedTitle %></title>
+                    <link type="text/html" href=blogURL />
+                    <link rel="self" type="application/atom+xml" href=atomURL />
+                    <author>
+                     <name><% feedAuthorName %></name>
+                    </author>
+                    <updated><% atomDate $ mostRecentUpdate pages %></updated>
+                    <id><% "urn:uuid:" ++ toString feedUUID %></id>
+                    <% mapM entry pages %>
+                   </feed>
+
+mostRecentUpdate :: [Page]  -- ^ pages to consider
+                 -> UTCTime -- ^ most recent updated time
+mostRecentUpdate []    = posixSecondsToUTCTime 0
+mostRecentUpdate pages =
+    maximum $ map pageUpdated pages
+
+entry :: Page
+      -> PageM XML
+entry Page{..} =
+  do viewPageSlug <- withAbs $ showURL (ViewPageSlug pageId (toSlug pageTitle pageSlug))
+     unXMLGenT $ <entry>
+                   <title><% pageTitle %></title>
+                   <link href=viewPageSlug />
+                   <id><% "urn:uuid:" ++ toString pageUUID %></id>
+                   <% author %>
+                   <updated><% atomDate pageUpdated %></updated>
+                   <% atomContent pageSrc %>
+                 </entry>
+    where
+      author :: XMLGenT PageM XML
+      author =
+          do mu <- query $ UsernameForId pageAuthor
+             case mu of
+               Nothing -> return $ cdata ""
+               (Just n)
+                   | Text.null n ->
+                       return $ cdata ""
+                   | otherwise ->
+                       <author>
+                        <name><% n %></name>
+                       </author>
+
+atomDate :: UTCTime -> String
+atomDate time =
+    formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" time
+
+atomContent :: Markup -> PageM XML
+atomContent markup =
+    do c <- markupToContent markup
+       case c of
+         (PlainText txt) ->
+              unXMLGenT $ <content type="text"><% txt %></content>
+         (TrustedHtml html) ->
+              unXMLGenT $ <content type="html"><% html %></content>
+
+handleAtomFeed :: PageM Response
+handleAtomFeed =
+    do ps         <- query AllPosts
+       feedConfig <- query GetFeedConfig
+       xml <- atom feedConfig ps
+       ok $ toResponseBS (fromString "application/atom+xml;charset=utf-8") (UTF8.fromString $ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n" ++ renderXML xml)
addfile ./clckwrks-plugin-page/Clckwrks/Page/Monad.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/Monad.hs 1
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, RecordWildCards, TypeFamilies, TypeSynonymInstances #-}
+module Clckwrks.Page.Monad where
hunk ./clckwrks-plugin-page/Clckwrks/Page/Monad.hs 4
+import Control.Applicative           ((<$>))
+import Control.Monad                 (foldM)
+import Control.Monad.Reader          (MonadReader(ask,local), ReaderT(runReaderT))
+import Control.Monad.State           (StateT, put, get, modify)
+import Control.Monad.Trans           (MonadIO(liftIO))
+import qualified Data.Text.Lazy      as LT
+import Clckwrks.Acid                 (GetAcidState(..))
+import Clckwrks.Monad                (Content(..), ClckT(..), ClckFormT, ClckState(..), mapClckT, runClckT, withRouteClckT)
+import Clckwrks.URL                  (ClckURL)
+import Clckwrks.Page.Acid            (PageState(..))
+import Clckwrks.Page.Types           (Markup(..), runPreProcessors)
+import Clckwrks.Page.URL             (PageURL(..), PageAdminURL(..))
+import Clckwrks.Page.Types           (PageId(..))
+import Clckwrks.Plugin               (clckPlugin)
+import Control.Monad.Trans           (lift)
+import Data.Acid                     (AcidState)
+import Data.Data                     (Typeable)
+import qualified Data.Text           as T
+import qualified Data.Text.Lazy      as TL
+import Happstack.Server              (Happstack, Input, ServerPartT)
+import HSP                           (Attr((:=)), Attribute(MkAttr), EmbedAsAttr(..), EmbedAsChild(..), IsName(toName), XMLGenT, XML, pAttrVal)
+import Text.Reform                   (CommonFormError, FormError(..))
+import Web.Plugins.Core              (Plugin(..), getConfig, getPluginsSt, getPluginRouteFn)
+import Web.Routes                    (RouteT(..), showURL, withRouteT)
+
+data PageConfig = PageConfig
+    { pageState        :: AcidState PageState
+    , pageClckURL      :: ClckURL -> [(T.Text, Maybe T.Text)] -> T.Text
+    }
+
+type PageT m = ClckT PageURL (ReaderT PageConfig m)
+type PageT' url m = ClckT url (ReaderT PageConfig m)
+type PageM   = ClckT PageURL (ReaderT PageConfig (ServerPartT IO))
+type PageAdminM = ClckT PageAdminURL (ReaderT PageConfig (ServerPartT IO))
+
+
+runPageT :: PageConfig -> PageT m a -> ClckT PageURL m a
+runPageT mc m = mapClckT f m
+    where
+      f r = runReaderT r mc
+
+runPageT'' :: Monad m =>
+               (PageURL -> [(T.Text, Maybe T.Text)] -> T.Text)
+            -> PageConfig
+            -> PageT m a
+            -> ClckT url m a
+runPageT'' showPageURL stripeConfig m = ClckT $ withRouteT flattenURL $ unClckT $ runPageT stripeConfig $ m
+    where
+      flattenURL ::   ((url' -> [(T.Text, Maybe T.Text)] -> T.Text) -> (PageURL -> [(T.Text, Maybe T.Text)] -> T.Text))
+      flattenURL _ u p = showPageURL u p
+
+
+-- withRouteClckT ?
+flattenURLClckT :: (url1 -> [(T.Text, Maybe T.Text)] -> T.Text)
+                -> ClckT url1 m a
+                -> ClckT url2 m a
+flattenURLClckT showClckURL m = ClckT $ withRouteT flattenURL $ unClckT m
+    where
+      flattenURL _ = \u p -> showClckURL u p
+
+clckT2PageT :: (Functor m, MonadIO m, Typeable url1) =>
+             ClckT url1 m a
+          -> PageT m a
+clckT2PageT m =
+    do p <- plugins <$> get
+       (Just clckShowFn) <- getPluginRouteFn p (pluginName clckPlugin)
+       flattenURLClckT clckShowFn $ mapClckT addReaderT m
+    where
+      addReaderT :: (Monad m) => m (a, ClckState) -> ReaderT PageConfig m (a, ClckState)
+      addReaderT m =
+          do (a, cs) <- lift m
+             return (a, cs)
+
+data PageFormError
+    = PageCFE (CommonFormError [Input])
+      deriving Show
+
+instance FormError PageFormError where
+    type ErrorInputType PageFormError = [Input]
+    commonFormError = PageCFE
+
+instance (Functor m, Monad m) => EmbedAsChild (PageT m) PageFormError where
+    asChild e = asChild (show e)
+
+type PageForm = ClckFormT PageFormError PageM
+
+instance (Monad m) => MonadReader PageConfig (PageT' url m) where
+    ask = ClckT $ ask
+    local f (ClckT m) = ClckT $ local f m
+
+instance (Functor m, Monad m) => GetAcidState (PageT' url m) PageState where
+    getAcidState =
+        pageState <$> ask
+
+instance (IsName n) => EmbedAsAttr PageM (Attr n PageURL) where
+        asAttr (n := u) =
+            do url <- showURL u
+               asAttr $ MkAttr (toName n, pAttrVal (T.unpack url))
+
+instance (IsName n) => EmbedAsAttr PageM (Attr n ClckURL) where
+        asAttr (n := url) =
+            do showFn <- pageClckURL <$> ask
+               asAttr $ MkAttr (toName n, pAttrVal (T.unpack $ showFn url []))
+
+
+-- | convert 'Markup' to 'Content' that can be embedded. Generally by running the pre-processors needed.
+-- markupToContent :: (Functor m, MonadIO m, Happstack m) => Markup -> ClckT url m Content
+markupToContent :: (Functor m, MonadIO m, Happstack m) =>
+                   Markup
+                -> ClckT url m Content
+markupToContent Markup{..} =
+    do clckState <- get
+       transformers <- liftIO $ getPluginsSt (plugins clckState)
+       (markup', clckState') <- liftIO $ runClckT undefined clckState (foldM (\txt pp -> pp txt) (TL.fromStrict markup) transformers)
+       put clckState'
+       e <- liftIO $ runPreProcessors preProcessors trust (TL.toStrict markup')
+       case e of
+         (Left err)   -> return (PlainText err)
+         (Right html) -> return (TrustedHtml html)
+
+{-
+-- | update the 'currentPage' field of 'ClckState'
+setCurrentPage :: (MonadIO m) => PageId -> PageT m ()
+setCurrentPage pid =
+    modify $ \s -> s { pageCurrent = pid }
+-}
addfile ./clckwrks-plugin-page/Clckwrks/Page/Plugin.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/Plugin.hs 1
+{-# LANGUAGE RecordWildCards, FlexibleContexts, OverloadedStrings #-}
+module Clckwrks.Page.Plugin where
+
+import Clckwrks                  ( ClckwrksConfig(clckTopDir), ClckState(plugins), ClckT(..), ClckURL, ClckPlugins, Theme
+                                 , addAdminMenu, addPreProc                                 )
+import Clckwrks.Plugin           (clckPlugin)
+import Clckwrks.Page.Acid        (initialPageState)
+import Clckwrks.Page.Monad       (PageConfig(..), runPageT)
+import Clckwrks.Page.PreProcess  (pageCmd)
+import Clckwrks.Page.Route       (routePage)
+import Clckwrks.Page.URL         (PageURL(..), PageAdminURL(..))
+import Clckwrks.Page.Types       (PageId(..))
+import Control.Applicative       ((<$>))
+import Control.Monad.State       (get)
+import Data.Acid                 as Acid
+import Data.Acid.Local           (createCheckpointAndClose, openLocalStateFrom)
+import Data.Text                 (Text)
+import qualified Data.Text.Lazy  as TL
+import Data.Maybe                (fromMaybe)
+import Data.Set                  (Set)
+import Happstack.Server          (ServerPartT, Response, notFound, toResponse)
+import System.Directory          (createDirectoryIfMissing)
+import System.FilePath           ((</>))
+import Web.Routes                (toPathInfo, parseSegments, withRouteT, fromPathSegments)
+import Web.Plugins.Core          (Plugin(..), Plugins(..), When(..), addCleanup, addHandler, initPlugin, getConfig, getPluginRouteFn)
+
+pageHandler :: (PageURL -> [(Text, Maybe Text)] -> Text)
+              -> PageConfig
+              -> ClckPlugins
+              -> [Text]
+              -> ClckT ClckURL (ServerPartT IO) Response
+pageHandler showPageURL pageConfig plugins paths =
+    case parseSegments fromPathSegments paths of
+      (Left e)  -> notFound $ toResponse (show e)
+      (Right u) ->
+          ClckT $ withRouteT flattenURL $ unClckT $ runPageT pageConfig $ routePage u
+    where
+      flattenURL ::   ((url' -> [(Text, Maybe Text)] -> Text) -> (PageURL -> [(Text, Maybe Text)] -> Text))
+      flattenURL _ u p = showPageURL u p
+
+pageInit :: ClckPlugins
+           -> IO (Maybe Text)
+pageInit plugins =
+    do (Just pageShowFn) <- getPluginRouteFn plugins (pluginName pagePlugin)
+       (Just clckShowFn) <- getPluginRouteFn plugins (pluginName clckPlugin)
+       mTopDir <- clckTopDir <$> getConfig plugins
+       let basePath = maybe "_state" (\td -> td </> "_state") mTopDir -- FIXME
+           pageDir = maybe "_page" (\td -> td </> "_page") mTopDir
+           cacheDir = pageDir </> "_cache"
+       createDirectoryIfMissing True cacheDir
+
+       ips  <- initialPageState
+       acid <- openLocalStateFrom (basePath </> "page") ips
+       addCleanup plugins Always (createCheckpointAndClose acid)
+
+       let pageConfig = PageConfig { pageState     = acid
+                                   , pageClckURL   = clckShowFn
+                                   }
+
+       addPreProc plugins (pageCmd acid pageShowFn)
+       addHandler plugins (pluginName pagePlugin) (pageHandler pageShowFn pageConfig)
+
+       return Nothing
+
+addPageAdminMenu :: ClckT url IO ()
+addPageAdminMenu =
+    do p <- plugins <$> get
+       (Just pageShowURL) <- getPluginRouteFn p (pluginName pagePlugin)
+       let newPageURL    = pageShowURL (PageAdmin NewPage) []
+           pagesURL      = pageShowURL (PageAdmin Pages) []
+           feedConfigURL = pageShowURL (PageAdmin EditFeedConfig) []
+       addAdminMenu ("Pages/Posts"
+                    , [ ("New Page/Post"        , newPageURL)
+                      , ("Edit Page/Post"  , pagesURL)
+                      , ("Edit Feed Config", feedConfigURL)
+                      ]
+                    )
+
+pagePlugin :: Plugin PageURL Theme (ClckT ClckURL (ServerPartT IO) Response) (ClckT ClckURL IO ()) ClckwrksConfig [TL.Text -> ClckT ClckURL IO TL.Text]
+pagePlugin = Plugin
+    { pluginName       = "page"
+    , pluginInit       = pageInit
+    , pluginDepends    = []
+    , pluginToPathInfo = toPathInfo
+    , pluginPostHook   = addPageAdminMenu
+    }
+
+plugin :: ClckPlugins -- ^ plugins
+       -> Text        -- ^ baseURI
+       -> IO (Maybe Text)
+plugin plugins baseURI =
+    initPlugin plugins baseURI pagePlugin
+
addfile ./clckwrks-plugin-page/Clckwrks/Page/PreProcess.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/PreProcess.hs 1
+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
+{-# OPTIONS_GHC -F -pgmFtrhsx #-}
+module Clckwrks.Page.PreProcess where
+
+import Control.Monad.Trans (MonadIO(..))
+import Control.Applicative ((<*>), (*>), (<$>), (<|>), optional)
+import Clckwrks.Monad (ClckT, ClckState, transform, query, segments)
+import Clckwrks.Page.Acid (GetPageTitle(..), PageState)
+import Clckwrks.Page.URL   (PageURL(ViewPageSlug))
+import Clckwrks.Page.Types (PageId(..), slugify, toSlug)
+import Data.Acid                        (AcidState(..))
+import Data.Acid.Advanced               (query')
+import Data.Attoparsec.Text.Lazy        (Parser, Result(..), anyChar, char, choice, decimal, parse, skipMany, space, stringCI, skipMany, try)
+import Data.Attoparsec.Combinator (many1, manyTill, skipMany)
+import Data.String (fromString)
+import           Data.Text (Text, pack)
+import qualified Data.Text.Lazy         as TL
+import           Data.Text.Lazy.Builder (Builder)
+import qualified Data.Text.Lazy.Builder as B
+import HSP
+import HSP.HTML (renderAsHTML)
+import Web.Routes (showURL)
+
+-- TODO: move to reusable module
+parseAttr :: Text -> Parser ()
+parseAttr name =
+    do skipMany space
+       stringCI name
+       skipMany space
+       char '='
+       skipMany space
+
+qchar :: Parser Char
+qchar = (char '\\' *> anyChar) <|> anyChar
+
+text :: Parser Text
+text = pack <$> many1 qchar
+
+qtext :: Parser Text
+qtext = pack <$> (char '"' *> manyTill qchar (try $ char '"'))
+
+data PageCmd
+    = LinkPage PageId (Maybe Text)
+      deriving (Eq, Ord, Show)
+
+pageId :: Parser PageCmd
+pageId = LinkPage <$> (parseAttr (fromString "id") *> (PageId <$> decimal)) <*> (optional $ parseAttr (fromString "title") *> qtext)
+
+parseCmd :: Parser PageCmd
+parseCmd = pageId
+
+pageCmd :: (Functor m, MonadIO m) =>
+           AcidState PageState
+        -> (PageURL -> [(Text, Maybe Text)] -> Text)
+        -> TL.Text
+        -> ClckT url m TL.Text
+pageCmd pageAcid clckShowURL txt =
+    case parse (segments "page" parseCmd) txt of
+      (Fail _ _ e) -> return (TL.pack e)
+      (Done _ segments) ->
+          do b <- transform (applyCmd pageAcid clckShowURL) segments
+             return $ B.toLazyText b
+
+applyCmd pageAcid clckShowURL l@(LinkPage pid mTitle) =
+    do (ttl, slug) <-
+           case mTitle of
+             (Just t) -> return (t, Just $ slugify t)
+             Nothing  -> do mttl <- query' pageAcid (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
addfile ./clckwrks-plugin-page/Clckwrks/Page/Route.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/Route.hs 1
+{-# LANGUAGE OverloadedStrings #-}
+module Clckwrks.Page.Route where
+
+import Clckwrks                     (Role(..), requiresRole_)
+import Clckwrks.Monad               ( ClckState(plugins), Theme(themeBlog), query
+                                    , update, setUnique, themeTemplate, nestURL
+                                    )
+import Clckwrks.Page.Types          (Page(..), PageId(..), toSlug)
+import Clckwrks.Page.Acid           (GetPageTitle(..), IsPublishedPage(..), PageById(..))
+import Clckwrks.Page.Admin.EditFeedConfig (editFeedConfig)
+import Clckwrks.Page.Admin.EditPage (editPage)
+import Clckwrks.Page.Admin.NewPage  (newPage)
+import Clckwrks.Page.Admin.Pages    (pages)
+import Clckwrks.Page.Admin.PreviewPage (previewPage)
+import Clckwrks.Page.Atom           (handleAtomFeed)
+import Clckwrks.Page.Monad          (PageConfig(pageClckURL), PageM, clckT2PageT, markupToContent)
+import Clckwrks.Page.Types          (PageKind(PlainPage, Post))
+import Clckwrks.Page.URL            (PageURL(..), PageAdminURL(..))
+import Control.Applicative          ((<$>))
+import Control.Monad.Reader         (ask)
+import Control.Monad.State          (get)
+import Data.Text                    (Text)
+import qualified Data.Set           as Set
+import Happstack.Server             ( Response, Happstack, escape, notFound, toResponse
+                                    , ok, internalServerError
+                                    )
+import HSP                          (unXMLGenT)
+import Web.Routes.Happstack         (seeOtherURL)
+import Web.Plugins.Core             (getTheme)
+
+checkAuth :: PageURL
+          -> PageM PageURL
+checkAuth url =
+    do showFn <- pageClckURL <$> ask
+       let requiresRole = requiresRole_ showFn
+       case url of
+         ViewPage{}     -> return url
+         ViewPageSlug{} -> return url
+         Blog{}         -> return url
+         AtomFeed{}     -> return url
+         PageAdmin {}   -> requiresRole (Set.singleton Administrator) url
+
+-- | routes for 'AdminURL'
+routePageAdmin :: PageAdminURL -> PageM Response
+routePageAdmin url =
+    case url of
+      (EditPage pid)    -> editPage (PageAdmin url) pid
+      NewPage           -> newPage PlainPage
+      NewPost           -> newPage Post
+      (PreviewPage pid) -> previewPage pid -- FIXME
+      EditFeedConfig    -> editFeedConfig (PageAdmin url)
+      Pages             -> pages
+
+routePage :: PageURL
+          -> PageM Response
+routePage url' =
+    do url <- checkAuth url'
+       setUnique 0
+       case url of
+         (ViewPage pid) ->
+           do r <- query (GetPageTitle pid)
+              case r of
+                Nothing ->
+                    notFound $ toResponse ("Invalid PageId " ++ show (unPageId pid))
+                (Just (title, slug)) ->
+                    seeOtherURL (ViewPageSlug pid (toSlug title slug))
+
+         (ViewPageSlug pid _slug) ->
+           do published <- query (IsPublishedPage pid)
+              if published
+                 then do cs <- get
+                         (Just page) <- query (PageById pid)
+                         let ttl = pageTitle page
+                         bdy <- markupToContent (pageSrc page)
+                         clckT2PageT $ themeTemplate (plugins cs) ttl () bdy
+                 else do notFound $ toResponse ("Invalid PageId " ++ show (unPageId pid))
+
+         (Blog) ->
+           do p <- plugins <$> get
+              mTheme <- getTheme p
+              case mTheme of
+                Nothing -> escape $ internalServerError $ toResponse $ ("No theme package is loaded." :: Text)
+                (Just theme) -> internalServerError $ toResponse ("Theme flattening not supported yet." :: Text)
+
+         AtomFeed ->
+             do handleAtomFeed
+
+         (PageAdmin adminURL) -> routePageAdmin adminURL
addfile ./clckwrks-plugin-page/Clckwrks/Page/Types.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/Types.hs 1
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TemplateHaskell, TypeFamilies #-}
+module Clckwrks.Page.Types where
+
+import Clckwrks.Markup.HsColour (hscolour)
+import Clckwrks.Markup.Markdown (markdown)
+import Clckwrks.Types           (Trust(..))
+import Control.Applicative      ((<$>), optional)
+import Control.Monad.Trans      (MonadIO(liftIO))
+import Data.Aeson               (ToJSON(..), FromJSON(..))
+import Data.Char                (ord, toLower, isAlphaNum)
+import Data.Data                (Data, Typeable)
+import Data.Maybe               (fromMaybe)
+import Data.IxSet               (Indexable(..), IxSet, ixFun, ixSet)
+import Data.SafeCopy            (Migrate(..), base, deriveSafeCopy, extension)
+import Data.String              (fromString)
+import Data.Text                (Text)
+import qualified Data.Text      as Text
+import Data.Time                (UTCTime)
+import Data.Time.Clock.POSIX    (posixSecondsToUTCTime)
+import Data.UUID                (UUID)
+import Data.UUID.V5             (generateNamed, namespaceOID)
+import Happstack.Auth           (UserId(..))
+import Web.Routes               (PathInfo(..), anySegment)
+import System.Random            (randomIO)
+
+
+-- $(deriveSafeCopy 0 'base ''UUID)
+
+instance PathInfo PageId where
+    toPathSegments (PageId i) = toPathSegments i
+    fromPathSegments = PageId <$> fromPathSegments
+
+newtype PageId = PageId { unPageId :: Integer }
+    deriving (Eq, Ord, Show, Read, Data, Typeable)
+$(deriveSafeCopy 1 'base ''PageId)
+
+instance ToJSON PageId where
+    toJSON (PageId i) = toJSON i
+instance FromJSON PageId where
+    parseJSON n = PageId <$> parseJSON n
+
+data PreProcessor
+    = HsColour
+    | Markdown
+      deriving (Eq, Ord, Read, Show, Data, Typeable)
+$(deriveSafeCopy 1 'base ''PreProcessor)
+
+-- $(deriveJSON id ''PreProcessor)
+
+runPreProcessors :: (MonadIO m) => [PreProcessor] -> Trust -> Text -> m (Either Text Text)
+runPreProcessors [] _ txt = return (Right txt)
+runPreProcessors (p:ps) trust txt =
+    do e <- runPreProcessor p trust txt
+       case e of
+         (Left e) -> return (Left e)
+         (Right txt') -> runPreProcessors ps trust txt'
+
+runPreProcessor :: (MonadIO m) => PreProcessor -> Trust -> Text -> m (Either Text Text)
+runPreProcessor pproc trust txt =
+    do let f = case pproc of
+                 Markdown -> markdown Nothing trust
+                 HsColour -> hscolour Nothing
+       f txt
+
+data Markup_001
+    = Markup_001 { preProcessors_001 :: [PreProcessor]
+                 , markup_001 :: Text
+                 }
+      deriving (Eq, Ord, Read, Show, Data, Typeable)
+$(deriveSafeCopy 1 'base ''Markup_001)
+
+data Markup
+    = Markup { preProcessors :: [PreProcessor]
+             , markup        :: Text
+             , trust         :: Trust
+             }
+      deriving (Eq, Ord, Read, Show, Data, Typeable)
+$(deriveSafeCopy 2 'extension ''Markup)
+
+instance Migrate Markup where
+    type MigrateFrom Markup = Markup_001
+    migrate (Markup_001 pp mu) = Markup pp mu Trusted
+
+data PublishStatus
+    = Draft
+    | Revoked
+    | Published
+    | Scheduled
+      deriving (Eq, Ord, Read, Show, Data, Typeable)
+$(deriveSafeCopy 1 'base ''PublishStatus)
+
+data PageKind
+    = PlainPage
+    | Post
+      deriving (Eq, Ord, Read, Show, Data, Typeable)
+$(deriveSafeCopy 1 'base ''PageKind)
+
+data Page_001
+    = Page_001 { pageId_001        :: PageId
+               , pageTitle_001     :: Text
+               , pageSrc_001       :: Markup
+               , pageExcerpt_001   :: Maybe Markup
+               , pageDate_001      :: Maybe UTCTime
+               , pageStatus_001    :: PublishStatus
+               , pageKind_001      :: PageKind
+               }
+      deriving (Eq, Ord, Read, Show, Data, Typeable)
+$(deriveSafeCopy 1 'base ''Page_001)
+
+data Page_002
+    = Page_002 { pageId_002        :: PageId
+               , pageAuthor_002    :: UserId
+               , pageTitle_002     :: Text
+               , pageSrc_002       :: Markup
+               , pageExcerpt_002   :: Maybe Markup
+               , pageDate_002      :: UTCTime
+               , pageUpdated_002   :: UTCTime
+               , pageStatus_002    :: PublishStatus
+               , pageKind_002      :: PageKind
+               , pageUUID_002      :: UUID
+               }
+      deriving (Eq, Ord, Read, Show, Data, Typeable)
+$(deriveSafeCopy 2 'extension ''Page_002)
+
+instance Migrate Page_002 where
+    type MigrateFrom Page_002 = Page_001
+    migrate (Page_001 pi pt ps pe pd pst pk) =
+        (Page_002 pi (UserId 1) pt ps pe (fromMaybe epoch pd) (fromMaybe epoch pd) pst pk $ generateNamed namespaceOID (map (fromIntegral . ord) (show pi ++ show ps)))
+            where
+              epoch = posixSecondsToUTCTime 0
+
+newtype Slug = Slug { unSlug :: Text }
+    deriving (Eq, Ord, Data, Typeable, Read, Show)
+$(deriveSafeCopy 0 'base ''Slug)
+
+instance PathInfo Slug where
+    toPathSegments (Slug txt) = [txt]
+    fromPathSegments = Slug <$> anySegment
+
+-- NOTE: this instance will cause faulty behavior if the Maybe Slug is not at the end of the URL
+instance PathInfo (Maybe Slug) where
+    toPathSegments (Just slug) = toPathSegments slug
+    fromPathSegments = optional $ fromPathSegments
+
+slugify :: Text -> Slug
+slugify txt = Slug $ Text.dropWhileEnd (=='-') $ Text.map (\c -> if isAlphaNum c then (toLower c) else '-') txt
+
+toSlug :: Text -> Maybe Slug -> Slug
+toSlug txt slug = fromMaybe (slugify txt) slug
+
+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
+           }
+      deriving (Eq, Ord, Read, Show, Data, Typeable)
+$(deriveSafeCopy 3 'extension ''Page)
+
+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)
+
+instance Indexable Page where
+    empty = ixSet [ ixFun ((:[]) . pageId)
+                  , ixFun ((:[]) . pageDate)
+                  , ixFun ((:[]) . pageKind)
+                  , ixFun ((:[]) . pageDate)
+                  , ixFun ((:[]) . pageStatus)
+                  ]
+
+type Pages = IxSet Page
+
+data FeedConfig = FeedConfig
+    { feedUUID       :: UUID -- ^ UUID which identifies this feed. Should probably never change
+--    , feedCategory :: Set Text
+    , feedTitle      :: Text
+    , feedLink       :: Text
+    , feedAuthorName :: Text
+    }
+    deriving (Eq, Ord, Read, Show, Data, Typeable)
+$(deriveSafeCopy 0 'base ''FeedConfig)
+
+initialFeedConfig :: IO FeedConfig
+initialFeedConfig =
+    do uuid <- randomIO
+       return $ FeedConfig { feedUUID       = uuid
+                           , feedTitle      = fromString "Untitled Feed"
+                           , feedLink       = fromString ""
+                           , feedAuthorName = fromString "Anonymous"
+                           }
addfile ./clckwrks-plugin-page/Clckwrks/Page/URL.hs
hunk ./clckwrks-plugin-page/Clckwrks/Page/URL.hs 1
+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies #-}
+module Clckwrks.Page.URL where
+
+import Data.Data (Data, Typeable)
+import Data.SafeCopy               (SafeCopy(..), base, deriveSafeCopy)
+import Clckwrks.Page.Acid          (PageId(..))
+import Clckwrks.Page.Types         (Slug(..))
+import Web.Routes.TH               (derivePathInfo)
+
+data PageAdminURL
+    = EditPage PageId
+    | PreviewPage PageId
+    | Pages
+    | NewPage
+    | NewPost
+    | EditFeedConfig
+      deriving (Eq, Ord, Data, Typeable, Read, Show)
+$(deriveSafeCopy 0 'base ''PageAdminURL)
+$(derivePathInfo ''PageAdminURL)
+
+data PageURL
+    = ViewPage PageId
+    | ViewPageSlug PageId Slug
+    | Blog
+    | AtomFeed
+    | PageAdmin PageAdminURL
+      deriving (Eq, Ord, Data, Typeable, Read, Show)
+$(deriveSafeCopy 0 'base ''PageURL)
+$(derivePathInfo ''PageURL)
addfile ./clckwrks-plugin-page/LICENSE
hunk ./clckwrks-plugin-page/LICENSE 1
+Copyright (c) 2013, Jeremy Shaw
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Jeremy Shaw nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
addfile ./clckwrks-plugin-page/Setup.hs
hunk ./clckwrks-plugin-page/Setup.hs 1
+#!/usr/bin/env runghc
+
+module Main where
+
+import Distribution.Simple
+import Distribution.Simple.Program
+
+trhsxProgram = simpleProgram "trhsx"
+
+main :: IO ()
+main = defaultMainWithHooks simpleUserHooks {
+         hookedPrograms = [trhsxProgram]
+       }
addfile ./clckwrks-plugin-page/clckwrks-plugin-page.cabal
hunk ./clckwrks-plugin-page/clckwrks-plugin-page.cabal 1
+name:                clckwrks-plugin-page
+version:             0.1.0.0
+synopsis:            support for CMS/Blogging in clckwrks
+homepage:            http://www.clckwrks.com/
+license:             BSD3
+license-file:        LICENSE
+copyright:           2012, 2013 Jeremy Shaw, SeeReason Partners LLC
+author:              Jeremy Shaw
+maintainer:          jeremy@n-heptane.com
+category:            Clckwrks
+build-type:          Custom
+cabal-version:       >=1.8
hunk ./clckwrks-plugin-page/clckwrks-plugin-page.cabal 14
+source-repository head
+    type:     darcs
+    subdir:   clckwrks-plugin-page
+    location: http://hub.darcs.net/stepcut/clckwrks
+
+library
+  build-tools:
+    trhsx
+
+  exposed-modules:     Clckwrks.Page.Monad
+                       Clckwrks.Page.Route
+                       Clckwrks.Page.Types
+                       Clckwrks.Page.Plugin
+                       Clckwrks.Page.PreProcess
+--                       Clckwrks.Page.API
+                       Clckwrks.Page.Acid
+                       Clckwrks.Page.Admin.EditFeedConfig
+                       Clckwrks.Page.Admin.EditPage
+                       Clckwrks.Page.Admin.NewPage
+                       Clckwrks.Page.Admin.Pages
+                       Clckwrks.Page.Admin.PreviewPage
+                       Clckwrks.Page.URL
+                       Clckwrks.Page.Atom
+  build-depends:       base ==4.6.*,
+                       mtl ==2.1.*,
+                       text ==0.11.*,
+                       clckwrks ==0.15.*,
+                       acid-state ==0.8.*,
+                       happstack-server ==7.0.*,
+                       hsp ==0.7.*,
+                       reform ==0.1.*,
+                       web-plugins ==0.2.*,
+                       web-routes ==0.27.*,
+                       web-routes-happstack ==0.23.*,
+                       aeson ==0.6.*,
+                       ixset ==1.0.*,
+                       reform-happstack == 0.1.*,
+                       reform-hsp == 0.1.*,
+                       safecopy ==0.8.*,
+                       time ==1.4.*,
+                       uuid ==1.2.*,
+                       happstack-authenticate ==0.10.*,
+                       random ==1.0.*,
+                       containers ==0.5.*,
+                       magic ==1.0.*,
+                       directory ==1.2.*,
+                       filepath ==1.3.*,
+                       attoparsec ==0.10.*,
+                       happstack-hsp ==7.1.*,
+                       tagsoup ==0.12.*,
+                       web-routes-th == 0.22.*,
+                       utf8-string ==0.3.*,
+                       old-locale ==1.0.*
hunk ./clckwrks-theme-bootstrap/Theme.hs 36
-      <% googleAnalytics %>
+--      <% googleAnalytics %>
hunk ./clckwrks-theme-bootstrap/Theme.hs 44
+blog = undefined
+{-
hunk ./clckwrks-theme-bootstrap/Theme.hs 72
-
+-}
hunk ./clckwrks/Clckwrks.hs 6
-    , module Clckwrks.Page.API
-    , module Clckwrks.Page.Types
+--    , module Clckwrks.Page.API
+--    , module Clckwrks.Page.Types
hunk ./clckwrks/Clckwrks.hs 29
-import Clckwrks.Page.API
-import Clckwrks.Page.Types
+--import Clckwrks.Page.API
+-- import Clckwrks.Page.Types
hunk ./clckwrks/Clckwrks/Acid.hs 5
-import Clckwrks.Page.Acid          (PageState       , initialPageState)
+-- import Clckwrks.Page.Acid          (PageState       , initialPageState)
hunk ./clckwrks/Clckwrks/Acid.hs 26
-    , acidPage        :: AcidState PageState
+--    , acidPage        :: AcidState PageState
hunk ./clckwrks/Clckwrks/Acid.hs 36
-    initialPageState >>= \ips ->
+--    initialPageState >>= \ips ->
hunk ./clckwrks/Clckwrks/Acid.hs 40
-    bracket (openLocalStateFrom (basePath </> "page")        ips)                     (createArchiveCheckpointAndClose) $ \page ->
+--    bracket (openLocalStateFrom (basePath </> "page")        ips)                     (createArchiveCheckpointAndClose) $ \page ->
hunk ./clckwrks/Clckwrks/Acid.hs 44
-            (const $ f (Acid auth profile profileData page menu))
+            (const $ f (Acid auth profile profileData {- page -} menu))
hunk ./clckwrks/Clckwrks/Admin/EditFeedConfig.hs 1
-{-# LANGUAGE RecordWildCards #-}
-{-# OPTIONS_GHC -F -pgmFtrhsx #-}
-module Clckwrks.Admin.EditFeedConfig where
-
-import Clckwrks
-import Clckwrks.Admin.Template  (template)
-import Clckwrks.Page.Acid       (GetFeedConfig(..), SetFeedConfig(..))
-import Data.Text                (Text, pack)
-import Text.Reform
-import Text.Reform.Happstack
-import Text.Reform.HSP.Text
-
-editFeedConfig :: ClckURL -> Clck ClckURL Response
-editFeedConfig here =
-    do feedConfig <- query $ GetFeedConfig
-       action <- showURL here
-       template "edit feed config" () $
-                  <%>
-                   <% reform (form action) "ep" updateFeedConfig Nothing (feedConfigForm feedConfig) %>
-                  </%>
-    where
-      updateFeedConfig :: FeedConfig -> Clck ClckURL Response
-      updateFeedConfig fc =
-          do update (SetFeedConfig fc)
-             seeOtherURL (Admin Console)
-
-feedConfigForm :: FeedConfig -> ClckForm ClckURL FeedConfig
-feedConfigForm fc@FeedConfig{..} =
-    fieldset $
-     ol $
-      ((,) <$> (li $ label "Feed Title:")          ++> (li $ inputText feedTitle)
-           <*> (li $ label "Default Author Name:") ++> (li $ inputText feedAuthorName)
-           <* inputSubmit (pack "update")
-      )
-     `transformEither` toFeedConfig
-    where
-      toFeedConfig :: (Text, Text) -> Either ClckFormError FeedConfig
-      toFeedConfig (ttl, athr) =
-              Right $ fc { feedTitle      = ttl
-                         , feedAuthorName = athr
-                         }
rmfile ./clckwrks/Clckwrks/Admin/EditFeedConfig.hs
hunk ./clckwrks/Clckwrks/Admin/EditPage.hs 1
-{-# LANGUAGE QuasiQuotes #-}
-{-# OPTIONS_GHC -F -pgmFtrhsx #-}
-module Clckwrks.Admin.EditPage
-    ( editPage
-    ) where
-
-import Control.Applicative ((<$>), (<*>), (<*))
-import Clckwrks
-import Clckwrks.Admin.Template (template)
-import Clckwrks.Monad          (ClckFormError)
-import Clckwrks.Page.Acid      (Markup(..), Page(..), PageKind(..), PublishStatus(..), PreProcessor(..), PageById(..), UpdatePage(..))
-import Data.Maybe              (isJust, maybe)
-import Data.Text               (Text, pack)
-import qualified Data.Text     as Text
-import Data.Time.Clock         (getCurrentTime)
-import Text.Reform             ((<++), (++>), transformEitherM)
-import Text.Reform.Happstack   (reform)
-import Text.Reform.HSP.Text    (form, inputCheckbox, inputText, label, inputSubmit, select, textarea, fieldset, ol, li, setAttrs)
-
-data AfterSaveAction
-    = EditSomeMore
-    | VisitPage
-    | ShowPreview
-
-editPage :: ClckURL -> PageId -> Clck ClckURL Response
-editPage here pid =
-    do mPage <- query $ PageById pid
-       case mPage of
-         Nothing -> notFound $ toResponse $ "Page not found: " ++ show (unPageId pid)
-         (Just page) ->
-             do action <- showURL here
-                template "edit page" () $
-                  <%>
-                   <% reform (form action) "ep" updatePage Nothing (pageFormlet page) %>
-                  </%>
-    where
-      updatePage :: (Page, AfterSaveAction) -> Clck ClckURL Response
-      updatePage (page, afterSaveAction) =
-          do update (UpdatePage page)
-             case afterSaveAction of
-               EditSomeMore -> seeOtherURL (Admin $ EditPage    (pageId page))
-               VisitPage    -> seeOtherURL (ViewPageSlug (pageId page) (toSlug (pageTitle page) (pageSlug page)))
-               ShowPreview  -> seeOtherURL (Admin $ PreviewPage (pageId page))
-
-
-pageFormlet :: Page -> ClckForm ClckURL (Page, AfterSaveAction)
-pageFormlet page =
-    (fieldset $
-       ol $ (,,,,,,,)
-              <$> (li $ inputCheckbox hsColour <++ label "Highlight Haskell code with HsColour")
-              <*> ((li $ label "kind:")  ++> (li $ select [(PlainPage, "page"), (Post, "post")] (== (pageKind page))))
-              <*> ((li $ label "title:") ++> (li $ inputText (pageTitle page) `setAttrs` ("size" := "80") ))
-              <*> ((li $ label "slug (optional):") ++> (li $ inputText (maybe Text.empty unSlug $ pageSlug page) `setAttrs` ("size" := "80") ))
-              <*> ((li $ label "body:")  ++> (li $ textarea 80 25 (markup (pageSrc page))))
-              <*> inputSubmit (pack "save")
-              <*> inputSubmit (pack "preview")
-              <*> newPublishStatus (pageStatus page)
-    ) `transformEitherM` toPage
-    where
-      newPublishStatus :: PublishStatus -> ClckForm ClckURL (Maybe PublishStatus)
-      newPublishStatus Published = fmap (const Draft)     <$> inputSubmit (pack "save & unpublish")
-      newPublishStatus _         = fmap (const Published) <$> inputSubmit (pack "save & publish")
-      hsColour = HsColour `elem` (preProcessors $ pageSrc page)
-      toPage :: (MonadIO m) => (Bool, PageKind, Text, Text, Text, Maybe Text, Maybe Text, Maybe PublishStatus) -> m (Either ClckFormError (Page, AfterSaveAction))
-      toPage (haskell, kind, ttl, slug, 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 ]
-                                             , trust = Trusted
-                                             , markup = bdy
-                                             }
-                      , pageExcerpt = Nothing
-                      , pageDate    = pageDate page
-                      , pageUpdated = now
-                      , pageStatus  = case mpagestatus of
-                                        (Just newStatus) -> newStatus
-                                        Nothing          -> pageStatus page
-                      , pageKind    = kind
-                      , pageUUID    = pageUUID page
-                      }
-               , if isJust mpreview
-                 then ShowPreview
-                 else case mpagestatus of
-                       (Just Published) -> VisitPage
-                       _                -> EditSomeMore
-               )
rmfile ./clckwrks/Clckwrks/Admin/EditPage.hs
hunk ./clckwrks/Clckwrks/Admin/EditSettings.hs 7
-import Clckwrks.Page.Acid       (GetUACCT(..), SetUACCT(..))
+-- import Clckwrks.Page.Acid       (GetUACCT(..), SetUACCT(..))
hunk ./clckwrks/Clckwrks/Admin/EditSettings.hs 14
-editSettings here =
+editSettings here = ok $ toResponse "not implemented"
+{-
hunk ./clckwrks/Clckwrks/Admin/EditSettings.hs 41
-
+-}
hunk ./clckwrks/Clckwrks/Admin/NewPage.hs 1
-{-# OPTIONS_GHC -F -pgmFtrhsx #-}
-module Clckwrks.Admin.NewPage where
-
-import Clckwrks
-import Clckwrks.Page.Acid      as Acid
-import Clckwrks.Admin.Template (template)
-import Data.UUID               () -- instance Random UUID
-import Data.Time.Clock         (getCurrentTime)
-import System.Random           (randomIO)
-
-newPage :: PageKind -> Clck AdminURL Response
-newPage pageKind =
-    do method GET
-       template "Create New Page/Post" () $
-         <%>
-          <form action=Clckwrks.NewPage method="POST" enctype="multipart/form-data">
-           <button type="submit">Create New Page</button>
-          </form>
-          <form action=Clckwrks.NewPost method="POST" enctype="multipart/form-data">
-           <button type="submit">Create New Post</button>
-          </form>
-         </%>
-
-    <|>
-    do method POST
-       uuid <- liftIO $ randomIO
-       now  <- liftIO $ getCurrentTime
-       muid <- getUserId
-       case muid of
-         Nothing -> escape $ internalServerError $ toResponse "Clcwrks.Admin.NewPage.newPage was unable to obtain the current UserId"
-         (Just uid) ->
-             do page <- update (Acid.NewPage pageKind uid uuid now)
-                seeOtherURL (EditPage (pageId page))
rmfile ./clckwrks/Clckwrks/Admin/NewPage.hs
hunk ./clckwrks/Clckwrks/Admin/Pages.hs 1
-{-# OPTIONS_GHC -F -pgmFtrhsx #-}
-module Clckwrks.Admin.Pages where
-
-import Clckwrks                (AdminURL(..), Clck, ClckURL(..), PageId(..), Response, query)
-import Clckwrks.Admin.URL      (AdminURL(..))
-import Clckwrks.Admin.Template (template)
-import Clckwrks.Page.Acid      (PagesSummary(..))
-import Clckwrks.Page.Types     (Slug(..))
-import Data.Text               (Text)
-import HSP
-
-pages :: Clck AdminURL Response
-pages =
-    do pages <- query PagesSummary
-       template "page list" () $ editList pages
-
-editList ::  [(PageId, Text, Maybe Slug)] -> GenChildList (Clck AdminURL)
-editList [] = <%><p>There are currently no pages.</p></%>
-editList pgs =
-    <%>
-     <p>Edit Page</p>
-     <ul class="plain-list">
-      <% mapM editPageLI pgs %>
-     </ul>
-    </%>
-    where
-      editPageLI :: (PageId, Text, Maybe Slug) -> GenXML (Clck AdminURL)
-      editPageLI (pid, ttl, _slug) =
-          <li><a href=(EditPage pid)><% ttl %></a></li>
rmfile ./clckwrks/Clckwrks/Admin/Pages.hs
hunk ./clckwrks/Clckwrks/Admin/PreviewPage.hs 1
-{-# LANGUAGE QuasiQuotes #-}
-{-# OPTIONS_GHC -F -pgmFtrhsx #-}
-module Clckwrks.Admin.PreviewPage
-    ( previewPage
-    ) where
-
-import Clckwrks
-import Clckwrks.Admin.Template   (template)
-import Clckwrks.ProfileData.Acid (HasRole(..))
-import Clckwrks.Page.Acid        (Page(..), PublishStatus(..), PageById(..))
-import Clckwrks.Unauthorized     ()
-import Control.Monad.State       (get)
-import qualified Data.Set        as Set
-import Web.Plugins.Core          (getTheme)
-
-previewPage :: PageId -> Clck ClckURL Response
-previewPage pid =
-    do mPage <- query $ PageById pid
-       case mPage of
-         Nothing -> do notFound ()
-                       template "Page not found" () $ <% "Page not found: " ++ show (unPageId pid) %>
-         (Just page) ->
-           do muid <- getUserId
-              authorized <-
-                  case muid of
-                    Nothing    -> return False
-                    (Just uid) -> query $ HasRole uid (Set.singleton Administrator)
-              if authorized
-                 then do setCurrentPage pid
-                         cs <- get
-                         ttl <- getPageTitle
-                         bdy <- getPageContent
-                         mTheme <- getTheme (plugins cs)
-                         case mTheme of
-                           Nothing -> escape $ internalServerError $ toResponse "No theme package is loaded."
-                           (Just theme) -> fmap toResponse $ unXMLGenT $ (_themeTemplate theme ttl () bdy)
-                 else unauthorized (toResponse $ "Sorry, you need Administrator access to view this page.")
rmfile ./clckwrks/Clckwrks/Admin/PreviewPage.hs
hunk ./clckwrks/Clckwrks/Admin/Route.hs 6
-import Clckwrks.Admin.EditFeedConfig (editFeedConfig)
-import Clckwrks.Admin.EditPage       (editPage)
+--import Clckwrks.Admin.EditFeedConfig (editFeedConfig)
+--import Clckwrks.Admin.EditPage       (editPage)
hunk ./clckwrks/Clckwrks/Admin/Route.hs 9
-import Clckwrks.Admin.NewPage        (newPage)
-import Clckwrks.Admin.PreviewPage    (previewPage)
-import Clckwrks.Admin.Pages
+-- import Clckwrks.Admin.NewPage        (newPage)
+-- import Clckwrks.Admin.PreviewPage    (previewPage)
+-- import Clckwrks.Admin.Pages
hunk ./clckwrks/Clckwrks/Admin/Route.hs 21
-      (EditPage pid)    -> editPage (Admin url) pid
-      EditFeedConfig    -> editFeedConfig (Admin url)
hunk ./clckwrks/Clckwrks/Admin/Route.hs 22
-      NewPage           -> nestURL Admin $ newPage PlainPage
-      (PreviewPage pid) -> previewPage pid -- FIXME
-      NewPost           -> nestURL Admin $ newPage Post
-      Pages             -> nestURL Admin $ pages
hunk ./clckwrks/Clckwrks/Admin/Template.hs 72
-                 , (fromString "Edit Feed Config", EditFeedConfig)
-                 , (fromString "Edit Page/Post"  , Pages)
-                 , (fromString "New Page/Post"   , NewPage)
+--                 , (fromString "Edit Feed Config", EditFeedConfig)
+--                 , (fromString "Edit Page/Post"  , Pages)
+--                 , (fromString "New Page/Post"   , NewPage)
hunk ./clckwrks/Clckwrks/Admin/URL.hs 4
-import Clckwrks.Page.Types (PageId(..))
+-- import Clckwrks.Page.Types (PageId(..))
hunk ./clckwrks/Clckwrks/Admin/URL.hs 11
-    | EditPage PageId
-    | PreviewPage PageId
-    | EditFeedConfig
+--    | EditPage PageId
+--    | PreviewPage PageId
+--    | EditFeedConfig
hunk ./clckwrks/Clckwrks/Admin/URL.hs 15
-    | Pages
-    | NewPage
-    | NewPost
+--    | Pages
+--    | NewPage
+--    | NewPost
hunk ./clckwrks/Clckwrks/Menu/Acid.hs 19
-data MenuState url  = MenuState 
+data MenuState url  = MenuState
hunk ./clckwrks/Clckwrks/Menu/Edit.hs 9
-import Clckwrks.Page.Acid      (PageId(..), PagesSummary(..))
-import Clckwrks.Page.Types     (Slug(..), slugify)
+--import Clckwrks.Page.Acid      (PageId(..), PagesSummary(..))
+-- import Clckwrks.Page.Types     (Slug(..), slugify)
hunk ./clckwrks/Clckwrks/Menu/Edit.hs 31
-    do summaries <- query PagesSummary
-       let clckLinks = [ (toPathInfo Blog, fromString "Blog")
+    do -- summaries <- query PagesSummary
+       let summaries = undefined
+       let clckLinks = [ -- (toPathInfo Blog, fromString "Blog")
hunk ./clckwrks/Clckwrks/Menu/Edit.hs 63
-                        `(addPageMenu summaries)`;
+ /* -- FIXME                        `(addPageMenu summaries)`;*/
hunk ./clckwrks/Clckwrks/Menu/Edit.hs 110
-
+{-
hunk ./clckwrks/Clckwrks/Menu/Edit.hs 149
-
+-}
hunk ./clckwrks/Clckwrks/Menu/Edit.hs 324
-                                        (Just pid) -> LinkURL (ViewPage (PageId pid))
+--                                        (Just pid) -> LinkURL (ViewPage (PageId pid))
hunk ./clckwrks/Clckwrks/Monad.hs 15
+    , themeTemplate
hunk ./clckwrks/Clckwrks/Monad.hs 26
-    , markupToContent
+--    , markupToContent
hunk ./clckwrks/Clckwrks/Monad.hs 30
-    , setCurrentPage
hunk ./clckwrks/Clckwrks/Monad.hs 48
-import Clckwrks.Page.Types           (Markup(..), runPreProcessors)
+-- import Clckwrks.Page.Types           (Markup(..), runPreProcessors)
hunk ./clckwrks/Clckwrks/Monad.hs 50
-import Clckwrks.Page.Acid            (PageState, PageId)
+-- import Clckwrks.Page.Acid            (PageState, PageId)
hunk ./clckwrks/Clckwrks/Monad.hs 87
-import Happstack.Server              (Happstack, ServerMonad(..), FilterMonad(..), WebMonad(..), Input, Request(..), Response, HasRqData(..), ServerPartT, UnWebT, mapServerPartT, escape)
+import Happstack.Server              (Happstack, ServerMonad(..), FilterMonad(..), WebMonad(..), Input, Request(..), Response, HasRqData(..), ServerPartT, UnWebT, internalServerError, mapServerPartT, escape, toResponse)
hunk ./clckwrks/Clckwrks/Monad.hs 102
-import Web.Plugins.Core              (Plugins, getConfig, getPluginsSt, modifyPluginsSt)
+import Web.Plugins.Core              (Plugins, getConfig, getPluginsSt, modifyPluginsSt, getTheme)
hunk ./clckwrks/Clckwrks/Monad.hs 123
+
+themeTemplate :: ( EmbedAsChild (ClckT ClckURL (ServerPartT IO)) headers
+                 , EmbedAsChild (ClckT ClckURL (ServerPartT IO)) body
+                 ) =>
+                 ClckPlugins
+              -> T.Text
+              -> headers
+              -> body
+              -> ClckT ClckURL (ServerPartT IO) Response
+themeTemplate plugins ttl hdrs bdy =
+    do mTheme <- getTheme plugins
+       case mTheme of
+         Nothing -> escape $ internalServerError $ toResponse $ ("No theme package is loaded." :: T.Text)
+         (Just theme) -> fmap toResponse $ unXMLGenT $ (_themeTemplate theme ttl hdrs bdy)
+
+
+
hunk ./clckwrks/Clckwrks/Monad.hs 174
-                , currentPage      :: PageId
hunk ./clckwrks/Clckwrks/Monad.hs 240
--- | update the 'currentPage' field of 'ClckState'
-setCurrentPage :: (MonadIO m) => PageId -> ClckT url m ()
-setCurrentPage pid =
-    modify $ \s -> s { currentPage = pid }
-
hunk ./clckwrks/Clckwrks/Monad.hs 328
-
+{-
hunk ./clckwrks/Clckwrks/Monad.hs 331
-
+-}
hunk ./clckwrks/Clckwrks/Monad.hs 466
-
+{-
hunk ./clckwrks/Clckwrks/Monad.hs 469
-
+-}
hunk ./clckwrks/Clckwrks/Monad.hs 513
-
+{-
hunk ./clckwrks/Clckwrks/Monad.hs 528
-
+-}
hunk ./clckwrks/Clckwrks/Plugin.hs 5
-import Clckwrks.Page.PreProcess    (pageCmd)
+-- import Clckwrks.Page.PreProcess    (pageCmd)
hunk ./clckwrks/Clckwrks/Plugin.hs 24
-       addPreProc plugins (pageCmd clckShowFn)
+--       addPreProc plugins (pageCmd clckShowFn)
hunk ./clckwrks/Clckwrks/Plugin.hs 28
-
hunk ./clckwrks/Clckwrks/Route.hs 8
-import Clckwrks.Page.Acid          (GetPageTitle(..), IsPublishedPage(..))
-import Clckwrks.Page.Atom          (handleAtomFeed)
+-- import Clckwrks.Page.Acid          (GetPageTitle(..), IsPublishedPage(..))
+-- import Clckwrks.Page.Atom          (handleAtomFeed)
hunk ./clckwrks/Clckwrks/Route.hs 24
-themeTemplate :: ( EmbedAsChild (ClckT ClckURL (ServerPartT IO)) headers
-                 , EmbedAsChild (ClckT ClckURL (ServerPartT IO)) body
-                 ) =>
-                 ClckPlugins
-              -> Text
-              -> headers
-              -> body
-              -> ClckT ClckURL (ServerPartT IO) Response
-themeTemplate plugins ttl hdrs bdy =
-    do mTheme <- getTheme plugins
-       case mTheme of
-         Nothing -> escape $ internalServerError $ toResponse $ ("No theme package is loaded." :: Text)
-         (Just theme) -> fmap toResponse $ unXMLGenT $ (_themeTemplate theme ttl hdrs bdy)
-
-
hunk ./clckwrks/Clckwrks/Route.hs 29
-      ViewPage{}           -> return url
-      ViewPageSlug{}       -> return url
-      Blog{}               -> return url
-      AtomFeed{}           -> return url
+--      ViewPage{}           -> return url
+--      ViewPageSlug{}       -> return url
+--      Blog{}               -> return url
+--      AtomFeed{}           -> return url
hunk ./clckwrks/Clckwrks/Route.hs 47
+{-
hunk ./clckwrks/Clckwrks/Route.hs 76
+-}
hunk ./clckwrks/Clckwrks/Server.hs 9
-import Clckwrks.Page.Acid           (GetPageTitle(..), IsPublishedPage(..))
-import Clckwrks.Page.Atom           (handleAtomFeed)
-import Clckwrks.Page.PreProcess     (pageCmd)
+-- import Clckwrks.Page.Acid           (GetPageTitle(..), IsPublishedPage(..))
+-- import Clckwrks.Page.Atom           (handleAtomFeed)
+-- import Clckwrks.Page.PreProcess     (pageCmd)
hunk ./clckwrks/Clckwrks/Server.hs 42
-                                        , currentPage      = PageId 0
+--                                        , currentPage      = PageId 0
hunk ./clckwrks/Clckwrks/Types.hs 7
+import Data.UUID     (UUID)
+
+$(deriveSafeCopy 0 'base ''UUID)
hunk ./clckwrks/Clckwrks/Types.hs 19
-
hunk ./clckwrks/Clckwrks/Types.hs 20
+
+
hunk ./clckwrks/Clckwrks/URL.hs 12
-import Clckwrks.Page.Acid          (PageId(..))
+-- import Clckwrks.Page.Acid          (PageId(..))
+-- import Clckwrks.Page.Types         (Slug(..))
hunk ./clckwrks/Clckwrks/URL.hs 15
-import Clckwrks.Page.Types         (Slug(..))
hunk ./clckwrks/Clckwrks/URL.hs 22
-
+{-
hunk ./clckwrks/Clckwrks/URL.hs 34
-
+-}
hunk ./clckwrks/Clckwrks/URL.hs 36
+{-
hunk ./clckwrks/Clckwrks/URL.hs 41
-    | ThemeData FilePath
+-}
+    = ThemeData FilePath
hunk ./clckwrks/Clckwrks/URL.hs 48
-$(deriveSafeCopy 2 'extension ''ClckURL)
-
+$(deriveSafeCopy 2 'base ''ClckURL)
+{-
hunk ./clckwrks/Clckwrks/URL.hs 60
-
+-}
hunk ./clckwrks/clckwrks.cabal 40
-                   Clckwrks.Admin.NewPage
-                   Clckwrks.Admin.Pages
-                   Clckwrks.Admin.EditPage
-                   Clckwrks.Admin.EditFeedConfig
+--                   Clckwrks.Admin.NewPage
+--                   Clckwrks.Admin.Pages
+--                   Clckwrks.Admin.EditPage
+--                   Clckwrks.Admin.EditFeedConfig
hunk ./clckwrks/clckwrks.cabal 45
-                   Clckwrks.Admin.PreviewPage
+--                   Clckwrks.Admin.PreviewPage
hunk ./clckwrks/clckwrks.cabal 57
-                   Clckwrks.Page.Types
-                   Clckwrks.Page.Acid
-                   Clckwrks.Page.API
-                   Clckwrks.Page.Atom
-                   Clckwrks.Page.PreProcess
hunk ./example-dot-org/Main.hs 4
-import Clckwrks            (ClckwrksConfig(..), ClckState, plugins)
-import Clckwrks.GetOpts    (parseArgs, clckwrksOpts)
-import Clckwrks.Server     (simpleClckwrks)
-import Clckwrks.Plugin     (clckPlugin)
-import Data.Text           (Text)
-import Web.Plugins.Core    (initPlugin, setTheme)
-import System.Environment  (getArgs)
+import Clckwrks             (ClckwrksConfig(..), ClckState, plugins)
+import Clckwrks.GetOpts     (parseArgs, clckwrksOpts)
+import Clckwrks.Server      (simpleClckwrks)
+import Clckwrks.Plugin      (clckPlugin)
+import Clckwrks.Page.Plugin (pagePlugin)
+import Data.Text            (Text)
+import Web.Plugins.Core     (initPlugin, setTheme)
+import System.Environment   (getArgs)
hunk ./example-dot-org/Main.hs 54
-       _mError <- initPlugin p "" clckPlugin
+       initPlugin p "" clckPlugin
+       initPlugin p "" pagePlugin
hunk ./example-dot-org/example-dot-org.cabal 24
-                       containers               == 0.4.*,
+                       clckwrks-plugin-page     == 0.1.*,
+                       containers               >= 0.4 && < 0.6,