**20120110050245 Ignore-this: 443d84f8ff571b10aaeb5a1725c2e82b ] hunk ./clckwrks-dot-com/Main.hs 20 +import qualified Theme.Blog as Blog hunk ./clckwrks-dot-com/Main.hs 46 + , clckBlogHandler = staticBlogHandler hunk ./clckwrks-dot-com/Main.hs 123 - , routeSite (clckPageHandler cc) mediaConfig url + , routeSite cc mediaConfig url hunk ./clckwrks-dot-com/Main.hs 146 - s = mkSite (clckPageHandler cc) clckState mediaConfig + s = mkSite cc clckState mediaConfig hunk ./clckwrks-dot-com/Main.hs 150 - mapRouteT (\m -> evalStateT m clckState) $ unClckT $ routeSite (clckPageHandler cc) mediaConfig url + mapRouteT (\m -> evalStateT m clckState) $ unClckT $ routeSite cc mediaConfig url hunk ./clckwrks-dot-com/Main.hs 215 -routeSite :: Clck ClckURL Response -> MediaConfig -> SiteURL -> Clck SiteURL Response -routeSite pageHandler mediaConfig url = +routeSite :: ClckwrksConfig u -> MediaConfig -> SiteURL -> Clck SiteURL Response +routeSite cc mediaConfig url = hunk ./clckwrks-dot-com/Main.hs 219 - (C clckURL) -> nestURL C $ routeClck pageHandler clckURL + (C clckURL) -> nestURL C $ routeClck cc clckURL hunk ./clckwrks-dot-com/Main.hs 226 -mkSite :: Clck ClckURL Response -> ClckState -> MediaConfig -> Site SiteURL (ServerPart Response) -mkSite ph clckState media = setDefault (C $ ViewPage $ PageId 1) $ mkSitePI route' +mkSite :: ClckwrksConfig u -> ClckState -> MediaConfig -> Site SiteURL (ServerPart Response) +mkSite cc clckState media = setDefault (C $ ViewPage $ PageId 1) $ mkSitePI route' hunk ./clckwrks-dot-com/Main.hs 230 - evalStateT (unRouteT (unClckT $ routeSite ph media u) f) clckState + evalStateT (unRouteT (unClckT $ routeSite cc media u) f) clckState hunk ./clckwrks-dot-com/Main.hs 265 + +staticBlogHandler :: Clck ClckURL Response +staticBlogHandler = toResponse <$> unXMLGenT Blog.page + addfile ./clckwrks-theme-basic/Theme/Blog.hs hunk ./clckwrks-theme-basic/Theme/Blog.hs 1 +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -F -pgmFtrhsx #-} +<% +module Theme.Blog where + +import Clckwrks + +postsHTML :: XMLGenT (Clck ClckURL) XML +postsHTML = + do posts <- getPosts +

+ <% mapM postHTML posts %> + + +postHTML :: Page -> XMLGenT (Clck ClckURL) XML +postHTML Page{..} = +

<% pageTitle %>

+ <% pageDate %> + <% pageSrc %> +

permalink

+ +page :: XMLGenT (Clck ClckURL) XML + +%> + + + + Blog + + + + + + +

+ <% postsHTML %> +

+ + hunk ./clckwrks-theme-basic/Theme/Page.hs 28 - -

admin

- hunk ./clckwrks-theme-basic/clckwrks-theme-basic.cabal 16 - Exposed-modules: Theme.Home, + Exposed-modules: Theme.Blog, + Theme.Home, hunk ./clckwrks-theme-basic/data/style.css 121 +ol#blog-posts +{ + list-style-type: none; +} + + +#blog-posts h1 +{ + font-family: 'Lobster Two', cursive; + font-weight: 700; +} + +.pub-date +{ + font-style: italic; + color: #aaa; +} hunk ./clckwrks/Clckwrks.hs 7 + , module Clckwrks.Page.Types hunk ./clckwrks/Clckwrks.hs 30 +import Clckwrks.Page.Types hunk ./clckwrks/Clckwrks/Admin/EditPage.hs 9 -import Clckwrks.Page.Acid (Markup(..), Page(..), PublishStatus(..), PreProcessor(..), PageById(..), UpdatePage(..)) +import Clckwrks.Page.Acid (Markup(..), Page(..), PageKind(..), PublishStatus(..), PreProcessor(..), PageById(..), UpdatePage(..)) hunk ./clckwrks/Clckwrks/Admin/EditPage.hs 13 -import Text.Digestive.HSP.Html4 (inputCheckBox, inputText, label, setAttrs, submit) +import Text.Digestive.HSP.Html4 (inputCheckBox, inputSelect, inputText, label, setAttrs, submit) hunk ./clckwrks/Clckwrks/Admin/EditPage.hs 35 - ol $ (,,) <$> (li $ inputCheckBox hsColour <++ label "Highlight Haskell code with HsColour") - <*> ((li $ label "title:") ++> (li $ inputText (Just (pageTitle page)) `setAttrs` ("size" := "80"))) - <*> ((li $ label "body:") ++> (li $ inputTextArea (Just 80) (Just 25) (Just (markup (pageSrc page))))) - <* submit "update") + ol $ (,,,) <$> (li $ inputCheckBox hsColour <++ label "Highlight Haskell code with HsColour") + <*> ((li $ label "kind:") ++> (li $ inputSelect (pageKind page) [(PlainPage, "page"), (Post, "post")])) + <*> ((li $ label "title:") ++> (li $ inputText (Just (pageTitle page)) `setAttrs` ("size" := "80"))) + <*> ((li $ label "body:") ++> (li $ inputTextArea (Just 80) (Just 25) (Just (markup (pageSrc page))))) + <* submit "update") hunk ./clckwrks/Clckwrks/Admin/EditPage.hs 43 - toPage :: (MonadIO m) => (Bool, Text, Text) -> m (Either e Page) - toPage (haskell, ttl, bdy) = + toPage :: (MonadIO m) => (Bool, PageKind, Text, Text) -> m (Either e Page) + toPage (haskell, kind, ttl, bdy) = hunk ./clckwrks/Clckwrks/Admin/EditPage.hs 55 + , pageKind = kind hunk ./clckwrks/Clckwrks/Admin/NewPage.hs 17 - page <- update Acid.NewPage + page <- update (Acid.NewPage PlainPage) hunk ./clckwrks/Clckwrks/Monad.hs 289 -{- -instance EmbedAsChild Clck (Block t) where - asChild b = asChild $ - - -instance IsAttrValue Clck (HJScript (Exp t)) where - toAttrValue script = toAttrValue $ evaluateHJScript script - -instance IsAttrValue Clck (Block t) where - toAttrValue block = return . attrVal $ "javascript:" ++ show block hunk ./clckwrks/Clckwrks/Monad.hs 290 -instance (IsName n) => HSX.EmbedAsAttr Clck (Attr n (HJScript (Exp a))) where - asAttr (n := script) = return . (:[]) . FAttr $ MkAttr (toName n, attrVal $ show $ evaluateHJScript script) --} hunk ./clckwrks/Clckwrks/Monad.hs 386 +instance (Functor m, Monad m, EmbedAsChild (ClckT url m) a) => EmbedAsChild (ClckT url m) (Maybe a) where + asChild Nothing = asChild () + asChild (Just a) = asChild a + hunk ./clckwrks/Clckwrks/Page/API.hs 12 + , getPosts hunk ./clckwrks/Clckwrks/Page/API.hs 94 - - +-- | get all posts, sorted reverse cronological +getPosts :: XMLGenT (Clck url) [Page] +getPosts = query AllPosts hunk ./clckwrks/Clckwrks/Page/Acid.hs 12 + , AllPosts(..) hunk ./clckwrks/Clckwrks/Page/Acid.hs 15 -import Clckwrks.Page.Types (Markup(..), PublishStatus(..), PreProcessor(..), PageId(..), Page(..), Pages(..)) +import Clckwrks.Page.Types (Markup(..), PublishStatus(..), PreProcessor(..), PageId(..), PageKind(..), Page(..), Pages(..)) hunk ./clckwrks/Clckwrks/Page/Acid.hs 22 -import Data.IxSet (Indexable, IxSet, (@=), empty, fromList, getOne, ixSet, ixFun, insert, toList, updateIx) +import Data.IxSet (Indexable, IxSet, (@=), Proxy(..), empty, fromList, getOne, ixSet, ixFun, insert, toList, toDescList, updateIx) hunk ./clckwrks/Clckwrks/Page/Acid.hs 25 -import Data.Time.Clock (getCurrentTime) +import Data.Time.Clock (UTCTime, getCurrentTime) hunk ./clckwrks/Clckwrks/Page/Acid.hs 31 - , posts :: IxSet Page hunk ./clckwrks/Clckwrks/Page/Acid.hs 46 + , pageKind = PlainPage hunk ./clckwrks/Clckwrks/Page/Acid.hs 49 - , posts = fromList [] hunk ./clckwrks/Clckwrks/Page/Acid.hs 70 -newPage :: Update PageState Page -newPage = +newPage :: PageKind -> Update PageState Page +newPage pk = hunk ./clckwrks/Clckwrks/Page/Acid.hs 81 + , pageKind = pk hunk ./clckwrks/Clckwrks/Page/Acid.hs 84 - , pages = insert page pages + , pages = insert page pages hunk ./clckwrks/Clckwrks/Page/Acid.hs 88 -newPost :: Update PageState Page -newPost = - do ps@PageState{..} <- get - let page = Page { pageId = nextPageId - , pageTitle = "Untitled" - , pageSrc = Markup { preProcessors = [ Markdown ] - , markup = Text.empty - } - , pageExcerpt = Nothing - , pageDate = Nothing - , pageStatus = Draft - } - put $ ps { nextPageId = PageId $ succ $ unPageId nextPageId - , pages = insert page pages - } - return page +-- | get all posts, sorted reverse cronological +allPosts :: Query PageState [Page] +allPosts = + do pgs <- pages <$> ask + return $ toDescList (Proxy :: Proxy (Maybe UTCTime)) (pgs @= Post) hunk ./clckwrks/Clckwrks/Page/Acid.hs 96 - , 'newPost hunk ./clckwrks/Clckwrks/Page/Acid.hs 99 + , 'allPosts hunk ./clckwrks/Clckwrks/Page/Types.hs 68 +data PageKind + = PlainPage + | Post + deriving (Eq, Ord, Read, Show, Data, Typeable) +$(deriveSafeCopy 1 'base ''PageKind) + hunk ./clckwrks/Clckwrks/Page/Types.hs 81 + , pageKind :: PageKind hunk ./clckwrks/Clckwrks/Page/Types.hs 88 + , ixFun ((:[]) . pageDate) + , ixFun ((:[]) . pageKind) hunk ./clckwrks/Clckwrks/Server.hs 34 + , clckBlogHandler :: Clck ClckURL Response hunk ./clckwrks/Clckwrks/Server.hs 55 - simpleHTTP (nullConf { port = clckPort cc }) (handlers (clckPageHandler cc) clckState) + simpleHTTP (nullConf { port = clckPort cc }) (handlers cc clckState) hunk ./clckwrks/Clckwrks/Server.hs 57 - handlers ph clckState = + handlers cc clckState = hunk ./clckwrks/Clckwrks/Server.hs 63 - , implSite (Text.pack $ "http://" ++ clckHostname cc ++ ":" ++ show (clckPort cc)) (Text.pack "") (clckSite ph clckState) + , implSite (Text.pack $ "http://" ++ clckHostname cc ++ ":" ++ show (clckPort cc)) (Text.pack "") (clckSite cc clckState) hunk ./clckwrks/Clckwrks/Server.hs 79 + Blog{} -> return url hunk ./clckwrks/Clckwrks/Server.hs 86 -routeClck :: Clck ClckURL Response -> ClckURL -> Clck ClckURL Response -routeClck pageHandler url' = +routeClck :: ClckwrksConfig u -> ClckURL -> Clck ClckURL Response +routeClck cc url' = hunk ./clckwrks/Clckwrks/Server.hs 93 - pageHandler + (clckPageHandler cc) + (Blog) -> + do clckBlogHandler cc hunk ./clckwrks/Clckwrks/Server.hs 120 -routeClck' :: Clck ClckURL Response -> ClckState -> ClckURL -> RouteT ClckURL (ServerPartT IO) Response -routeClck' pageHandler clckState url = - mapRouteT (\m -> evalStateT m clckState) $ (unClckT $ routeClck pageHandler url) +routeClck' :: ClckwrksConfig u -> ClckState -> ClckURL -> RouteT ClckURL (ServerPartT IO) Response +routeClck' cc clckState url = + mapRouteT (\m -> evalStateT m clckState) $ (unClckT $ routeClck cc url) hunk ./clckwrks/Clckwrks/Server.hs 124 -clckSite :: Clck ClckURL Response -> ClckState -> Site ClckURL (ServerPart Response) -clckSite ph clckState = setDefault (ViewPage $ PageId 1) $ mkSitePI route' +clckSite :: ClckwrksConfig u -> ClckState -> Site ClckURL (ServerPart Response) +clckSite cc clckState = setDefault (ViewPage $ PageId 1) $ mkSitePI route' hunk ./clckwrks/Clckwrks/Server.hs 127 - route' f u = unRouteT (routeClck' ph clckState u) f + route' f u = unRouteT (routeClck' cc clckState u) f hunk ./clckwrks/Clckwrks/URL.hs 25 + | Blog