informative 0.1.0.1 → 0.1.0.2

raw patch · 6 files changed

+131/−17 lines, 6 filesdep +yesod-formPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: yesod-form

API changes (from Hackage documentation)

Files

• Web/Informative.hs +56/−8
• Web/Informative/Data.hs +2/−2
• informative-edit.htm +57/−0
• informative.cabal +5/−5
• informative.css +8/−0
• informative.htm +3/−2

@@ -2,6 +2,8 @@  module Web.Informative where +import Control.Applicative+import Control.Arrow import Control.Monad import qualified Data.Text as T import Data.Time.Clock@@ -15,8 +17,9 @@ import Web.Informative.Data import Yesod import Yesod.Auth+import Yesod.Form -type WikiHandler a = forall master. (Yesod master, YesodWikiAuth master, YesodPersist master, YesodPersistBackend master ~ SqlPersistT) => HandlerT Informative (HandlerT master IO) a+type WikiHandler a = forall master. (YesodWikiAuth master, YesodPersist master, YesodPersistBackend master ~ SqlPersistT) => HandlerT Informative (HandlerT master IO) a  class (Yesod master, RenderMessage master FormMessage) => YesodWikiAuth master where   getAuthR :: HandlerT master IO (AuthRoute -> Route master)@@ -40,6 +43,12 @@   section WikisectionId   index Int   UniqueRel page section+Wikisugg+  page T.Text+  segment T.Text+  index Int+  caption T.Text+  UniqueSugg page segment |]  readFmt Markdown = P.readMarkdown@@ -60,7 +69,7 @@ getArticleIdR pageid = do   seg <- liftM getSegment getYesod   pref <- liftM getPrefix getYesod-  (edits,sects',page) <- lift $ runDB $ do+  (edits,sects',page,suggs) <- lift $ runDB $ do     let pid = Key (PersistInt64 $ fromIntegral pageid) :: WikipageId     wp <- get pid     (sects,page) <- case wp of@@ -72,7 +81,8 @@         return (s', wikipageTitle p)     hs <- selectList [WikipageTitle ==. page, WikipageSegment ==. seg] [Desc WikipageTimestamp, LimitTo 10]     let es = map (\(Entity (Key (PersistInt64 pid)) p) -> (pid, wikipageEditor p, wikipageTimestamp p)) hs-    return (es,sects,page)+    suggs <- selectList [WikisuggSegment ==. seg] [Asc WikisuggIndex]+    return (es,sects,page,suggs)   toParent <- getRouteToParent   mayEdit <- lift $ isAuthorized (toParent $ ArticleR page) True   authR <- lift getAuthR@@ -88,16 +98,17 @@ getArticleR page = do   seg <- liftM getSegment getYesod   pref <- liftM getPrefix getYesod-  (edits,sects') <- lift $ runDB $ do+  (edits,sects',suggs) <- lift $ runDB $ do     wp <- selectList [WikipageTitle ==. page, WikipageSegment ==. seg] [Desc WikipageTimestamp, LimitTo 10]+    suggs <- selectList [WikisuggSegment ==. seg] [Asc WikisuggIndex]     case wp of-      [] -> return ([], [(-1,Left $ convFmt LaTeX "\\section{404 Not Found} We're sorry, but that article doesn't exist in our database.", Error)])+      [] -> return ([], [(-1,Left $ convFmt LaTeX "\\section{404 Not Found} We're sorry, but that article doesn't exist in our database.", Error)],suggs)       hs@((Entity pid p):_) -> do         rels <- selectList [WikirelPage ==. pid] [Asc WikirelIndex]         sects <- forM rels $ \(Entity (Key (PersistInt64 rid)) r) -> liftM (rid,) $ get $ wikirelSection r         let s' = map (\(rid,Just  s) -> (rid,convSect (wikisectionKind s) (wikisectionFormat s) (wikisectionContent s), wikisectionKind s)) sects             es = map (\(Entity (Key (PersistInt64 pid)) p) -> (pid, wikipageEditor p, wikipageTimestamp p)) hs-        return (es, s')+        return (es, s',suggs)   toParent <- getRouteToParent   mayEdit <- lift $ isAuthorized (toParent $ ArticleR page) True   authR <- lift getAuthR@@ -109,9 +120,46 @@     toWidget $(hamletFile "informative.htm")     toWidget $(cassiusFile "informative.css") +data SectionData = SectionData {+  sdKind :: TextKind,+  sdFormat :: TextFormat,+  sdContent :: Textarea+  }++editSectionForm :: RenderMessage master FormMessage => Maybe SectionData -> Html -> MForm (HandlerT master IO) (FormResult SectionData, WidgetT master IO ())+editSectionForm mdata = renderDivs $ SectionData+                        <$> areq (selectFieldList kinds) "Kind:" (sdKind <$> mdata)+                        <*> areq (selectFieldList formats) "Format:" (sdFormat <$> mdata)+                        <*> areq textareaField "Content:" (sdContent <$> mdata)+  where formats = map (T.pack . show &&& id) [minBound..maxBound]+        kinds = map (T.pack . show &&& id) [minBound..maxBound]+ getEditR :: T.Text -> Int -> WikiHandler Html-getEditR page sect = do-  lift $ defaultLayout [whamlet| Woohoo, we are editing this!|]+getEditR page rid = do+  seg <- liftM getSegment getYesod+  pref <- liftM getPrefix getYesod+  (msect, mprec, kind, fmt, suggs) <- lift $ runDB $ do+    suggs <- selectList [WikisuggSegment ==. seg] [Asc WikisuggIndex]+    rel <- get (Key (PersistInt64 $ fromIntegral rid) :: WikirelId)+    case rel of+      Nothing -> return (Nothing, Nothing, Error, Plain, suggs)+      Just rel -> do+        msect <- get $ wikirelSection rel+        case msect of+          Nothing -> return (Nothing, Nothing, Error, Plain, suggs)+          Just sect ->+            return (Just $ convSect (wikisectionKind sect) (wikisectionFormat sect) (wikisectionContent sect), Just $ wikisectionContent sect, wikisectionKind sect, wikisectionFormat sect, suggs)+  toParent <- getRouteToParent+  authR <- lift getAuthR+  loggedIn <- lift isLoggedIn+  mmsg <- getMessage+  (formw, enctype) <- lift $ generateFormPost $ editSectionForm $ liftM (\t -> SectionData kind fmt $ Textarea t) mprec+  form <- lift $ widgetToPageContent formw+  lift $ wikiLayout $ do+    setTitle $ toHtml page+    toWidget $ pageHead form+    toWidget $(hamletFile "informative-edit.htm")+    toWidget $(cassiusFileReload "informative.css")  instance (YesodWikiAuth master, YesodPersist master, YesodPersistBackend master ~ SqlPersistT) => YesodSubDispatch Informative (HandlerT master IO) where   yesodSubDispatch = $(mkYesodSubDispatch resourcesInformative)

@@ -13,8 +13,8 @@  /edit/#Text/#Int EditR GET |] -data TextFormat = Markdown | MediaWiki | ReStructuredText | LaTeX | Plain deriving (Eq,Ord,Show,Read)+data TextFormat = Markdown | MediaWiki | ReStructuredText | LaTeX | Plain deriving (Eq,Ord,Show,Read, Enum, Bounded) derivePersistField "TextFormat" -data TextKind = Article | Table | Mapping | Hint | Error deriving (Eq, Ord, Show, Read)+data TextKind = Article | Table | Mapping | Hint | Error deriving (Eq, Ord, Show, Read, Enum, Bounded) derivePersistField "TextKind"

@@ -0,0 +1,57 @@+<h1 #header>#{page}+<div #leftnav>+  <ul .leftnav title="Suggested">+    $forall (Entity _ sugg) <- suggs+      <li>+        <a href=@{toParent $ ArticleR $ wikisuggPage sugg}>#{wikisuggCaption sugg}+  <ul .leftnav title="Actions">+    $if loggedIn+      <li>+        <a href=@{authR LogoutR}>Logout+    $else+      <li>+        <a href=@{authR LoginR}>Login+<div #content>+  $maybe msg <- mmsg+    <div .hint>+      #{msg}+  $maybe sect <- msect+    $case (sect, kind)+      $of (Left c, Article)+        <div .content>+          #{c}+      $of (Left c, Hint)+        <div .hint>+          #{c}+      $of (Left c, Error)+        <div .error>+          #{c}+      $of (Right [], _)+        <div .error>+          Empty table.+      $of (Right rows, Table)+        <div .table>+          <table>+            <thead>+              $forall h <- head rows+                <th>#{h}+            $forall cols <- tail rows+              <tr>+                $forall c <- cols+                  <td>#{c}+      $of (Right rows, Mapping)+        <div .mapping>+          <table>+            $forall cols <- rows+              <tr>+                $forall c <- cols+                  <td>#{c}+  $nothing+    <div .hint>+      You are creating a new section.+  <div .content>+    <p>+      <form method=post action=@{toParent $ EditR page rid} enctype=#{enctype}>+        ^{pageBody form}+        <button type="submit" name="action" value="save">Save+        <button type="submit" name="action" value="preview" default>Preview

@@ -10,13 +10,13 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.0.1+version:             0.1.0.2  -- A short (one-line) description of the package. synopsis:            A yesod subsite serving a wiki.  -- A longer description of the package.--- description:         +description:         A yesod subsite serving a wiki.  -- URL for the project homepage or repository. homepage:            http://doomanddarkness.eu/pub/informative@@ -43,7 +43,7 @@  -- Extra files to be distributed with the package, such as examples or a  -- README.-extra-source-files:  informative.htm, informative.css+extra-source-files:  informative.htm, informative-edit.htm, informative.css  -- Constraint on the version of Cabal needed to build this package. cabal-version:       >=1.10@@ -59,7 +59,7 @@   -- other-extensions:          -- Other library packages from which modules are imported.-  build-depends:       base >=4.6 && <4.8, yesod >=1.2 && <1.3, text >=1.1 && <1.2, persistent-postgresql >=1.3 && <1.4, monad-logger >=0.3 && <0.4, persistent >=1.3 && <1.4, pandoc >=1.10, shakespeare >=2.0 && <2.1, time >=1.4 && <1.5, old-locale >= 1.0, csv >=0.1 && <0.2, yesod-auth >=1.3 && <1.4, http-conduit >=2.1 && <2.2, yesod-core >=1.2 && <1.3+  build-depends:       base >=4.6 && <4.8, yesod >=1.2 && <1.3, text >=1.1 && <1.2, persistent-postgresql >=1.3 && <1.4, monad-logger >=0.3 && <0.4, persistent >=1.3 && <1.4, pandoc >=1.10, shakespeare >=2.0 && <2.1, time >=1.4 && <1.5, old-locale >= 1.0, csv >=0.1 && <0.2, yesod-auth >=1.3 && <1.4, http-conduit >=2.1 && <2.2, yesod-core >=1.2 && <1.3, yesod-form >=1.3 && <1.4      -- Directories containing source files.   -- hs-source-dirs:      @@ -68,6 +68,6 @@   default-language:    Haskell2010    executable informative-test-  build-depends:       base >=4.6 && <4.8, yesod >=1.2 && <1.3, text >=1.1 && <1.2, persistent-postgresql >=1.3 && <1.4, monad-logger >=0.3 && <0.4, persistent >=1.3 && <1.4, pandoc >=1.10, shakespeare >=2.0 && <2.1, time >=1.4 && <1.5, old-locale >= 1.0, csv >=0.1 && <0.2, yesod-auth >=1.3 && <1.4, http-conduit >=2.1 && <2.2, yesod-core >=1.2 && <1.3+  build-depends:       base >=4.6 && <4.8, yesod >=1.2 && <1.3, text >=1.1 && <1.2, persistent-postgresql >=1.3 && <1.4, monad-logger >=0.3 && <0.4, persistent >=1.3 && <1.4, pandoc >=1.10, shakespeare >=2.0 && <2.1, time >=1.4 && <1.5, old-locale >= 1.0, csv >=0.1 && <0.2, yesod-auth >=1.3 && <1.4, http-conduit >=2.1 && <2.2, yesod-core >=1.2 && <1.3, yesod-form >=1.3 && <1.4   main-is:             informative-test.hs   default-language:    Haskell2010

@@ -152,3 +152,11 @@  div#content div.edit a   color: navy;++textarea+  width: 100em;+  height: 30em;++label+  width: 10em;+  float: left;

@@ -1,8 +1,9 @@ <h1 #header>#{page} <div #leftnav>   <ul .leftnav title="Suggested">-    <li>-      <a href=@{toParent (ArticleR "main")}>Main page+    $forall (Entity _ sugg) <- suggs+      <li>+        <a href=@{toParent $ ArticleR $ wikisuggPage sugg}>#{wikisuggCaption sugg}   <ul .leftnav title="Actions">     $if loggedIn       <li>