[add ability to create a new page. Added a Page.API call to create a menu of the pages
Jeremy Shaw <jeremy@seereason.com>**20111106165323
 Ignore-this: 7d9cd7f76bf15e999d54d1a72f5d525a
] hunk ./Admin/Console.hs 8
-import Page.Acid
+import Page.Acid (PagesSummary(..))
hunk ./Admin/Console.hs 13
-       template "Administration" () $ editList pages
+       template "Administration" () $
+         <div>
+          <form action=(Admin NewPage) method="POST" enctype="multipart/form-data">
+           <button type="submit">Create New Page</button>
+          </form>
+          <% editList pages %>
+         </div>
hunk ./Admin/Console.hs 21
-editList ::  [(PageId, Text)] -> XMLGenT CMS XML
-editList [] = <p>There are currently no pages.</p>
+editList ::  [(PageId, Text)] -> GenChildList CMS
+editList [] = <%><p>There are currently no pages.</p></%>
hunk ./Admin/Console.hs 24
-    <ul class="plain-list">
-     <% mapM editPageLI pgs %>
-    </ul>
+    <%>
+     <p>Edit Page</p>
+     <ul class="plain-list">
+      <% mapM editPageLI pgs %>
+     </ul>
+    </%>
hunk ./Admin/Console.hs 31
-      editPageLI :: (PageId, Text) -> XMLGenT CMS XML
+      editPageLI :: (PageId, Text) -> GenXML CMS
hunk ./Admin/Console.hs 33
-          <a href=(Admin $ EditPage pid)><% ttl %></a>
+          <li><a href=(Admin $ EditPage pid)><% ttl %></a></li>
addfile ./Admin/NewPage.hs
hunk ./Admin/NewPage.hs 1
+{-# OPTIONS_GHC -F -pgmFtrhsx #-}
+module Admin.NewPage where
+
+import CMS
+import Page.Acid as Acid
+
+newPage :: CMS Response
+newPage =
+    do methodOnly POST
+       page <- update Acid.NewPage
+       seeOtherURL (Admin $ EditPage (pageId page))
hunk ./Admin/Route.hs 6
+import Admin.NewPage
hunk ./Admin/Route.hs 12
-      Console -> consolePage
+      Console        -> consolePage
hunk ./Admin/Route.hs 14
+      NewPage        -> newPage
hunk ./Admin/URL.hs 12
+    | NewPage
hunk ./Page.hs 14
+  <link type="text/css" href="/static/theme.css" rel="stylesheet" />
hunk ./Page.hs 17
+  <% getPageMenu %>
hunk ./Page/API.hs 2
+{-# OPTIONS_GHC -F -pgmFtrhsx #-}
hunk ./Page/API.hs 8
+    , getPagesSummary
+    , getPageMenu
hunk ./Page/API.hs 17
+import CMSURL
+import HSP hiding (escape)
hunk ./Page/API.hs 36
+
+getPagesSummary :: CMS [(PageId, Text)]
+getPagesSummary = query PagesSummary
+
+getPageMenu :: GenXML CMS 
+getPageMenu = 
+    do ps <- XMLGenT $ query PagesSummary
+       case ps of
+         [] -> <div>No pages found.</div>
+         _ -> <ul class="page-menu">
+                <% mapM (\(pid, ttl) -> <li><a href=(ViewPage pid) title=ttl><% ttl %></a></li>) ps %>
+              </ul>
+    
hunk ./Page/Acid.hs 1
-{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies, RecordWildCards #-}
+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies, RecordWildCards, OverloadedStrings #-}
hunk ./Page/Acid.hs 8
+    , NewPage(..)
hunk ./Page/Acid.hs 19
-import Data.IxSet (Indexable, IxSet, (@=), empty, fromList, getOne, ixSet, ixFun, toList, updateIx)
+import Data.IxSet (Indexable, IxSet, (@=), empty, fromList, getOne, ixSet, ixFun, insert, toList, updateIx)
hunk ./Page/Acid.hs 21
-import Data.Text (Text, pack)
+import Data.Text (Text)
+import qualified Data.Text as Text
hunk ./Page/Acid.hs 36
-                                        , pageTitle = pack "This title rocks!"
-                                        , pageSrc   = Markdown $ pack "This is the body!"
+                                        , pageTitle = "This title rocks!"
+                                        , pageSrc   = Markdown $ "This is the body!"
hunk ./Page/Acid.hs 61
+newPage :: Update PageState Page
+newPage =
+    do ps@PageState{..} <- get
+       let page = Page { pageId = nextPageId
+                       , pageTitle = "Untitled"
+                       , pageSrc   = Markdown $ Text.empty
+                       }
+       put $ PageState { nextPageId = PageId $ succ $ unPageId nextPageId
+                       , pages = insert page pages
+                       }
+       return page
+
hunk ./Page/Acid.hs 74
-  [ 'pageById
+  [ 'newPage
+  , 'pageById
addfile ./static/theme.css
hunk ./static/theme.css 1
+ul.page-menu
+{
+    list-style-type: none;
+    padding: 0;
+}
+
+.page-menu li
+{
+    display: inline;
+    margin-right: 1em;
+}
+