Make comments editable. Add glyphicons. Link to papers.

snaplets/heist/templates/article_view.tpl

@@ -60,14 +60,19 @@
 
     <div class="article_view_header">
       <h2>
-	<docTitle/>
+	<a href="${articleURL}">
+	  <docTitle/>
+	</a>
       </h2>
       <p class="header-post-time">
 	<ifLoggedIn>
 	  <pinBoardBtn>
 	    <span> 
-	      <a href="/${pinUrl}/${docId}">
-		<button class="btn btn-primary btn-xs"><pinboardBtnTxt/></button>
+	      <a href="/${pinUrl}?paperid=${docId}">
+		<button class="btn btn-primary btn-xs">
+		  <span class="glyphicon glyphicon-pushpin"></span>
+		  <pinboardBtnTxt/>
+		</button>
 	      </a>
 	    </span>
 	  </pinBoardBtn>
@@ -82,7 +87,7 @@
 	<h3>Summaries 
 
           <ifLoggedIn>
-          <a href="/new_summary/${docId}">
+          <a href="/new_summary?paperid=${docId}">
             <button type="button" class="btn btn-primary btn-xs">New</button>
           </a>
           </ifLoggedIn>
@@ -98,7 +103,7 @@
       <div class="article_praise">
 	<h3>Praise  
 <ifLoggedIn>
-<a href="/new_praise/${docId}"><button type="button" class="btn btn-success btn-xs">New</button></a>
+<a href="/new_praise?paperid=${docId}"><button type="button" class="btn btn-success btn-xs">New</button></a>
 </ifLoggedIn>
 </h3>
 	<articlePraise>
@@ -111,7 +116,7 @@
       <div class="article_criticisms">
 	<h3>Criticism 
 <ifLoggedIn>
-<a href="/new_criticism/${docId}"><button type="button" class="btn btn-warning btn-xs">New</button></a></ifLoggedIn></h3>
+<a href="/new_criticism?paperid=${docId}"><button type="button" class="btn btn-warning btn-xs">New</button></a></ifLoggedIn></h3>
 	<articleCriticisms>
 	  <apply template="o_comment"/>
 	</articleCriticisms>

snaplets/heist/templates/new_o_comment.tpl

@@ -5,7 +5,7 @@
     <div class="form-group">
       <dfLabel ref="poster" class="col-sm-2 control-label">Post as: </dfLabel>
       <div class="col-sm-8">
-	<dfInputSelect ref="poster" class="form-control"/>
+	<dfInputSelect ref="poster" class="form-control" value="${poster}" ${posterDisabled}/>
       </div>
     </div>
 
@@ -16,15 +16,17 @@
       <div class="form-group">
 	<dfLabel ref="dimension" class="col-sm-2 control-label">About: </dfLabel>
 	<div class="col-sm-8">
-	  <dfInputSelect ref="dimension" class="form-control"/>
+	  <dfInputSelect ref="dimension" class="form-control" value="${value}"/>
 	</div>
       </div>
     </reBlock>
 
     <div class="form-group">
       <dfLabel ref="prose" class="col-sm-2 control-label">Comment: </dfLabel>
       <div class="col-sm-8">
-	<dfInputTextArea ref="prose" rows="10" cols="50" class="form-control"/>
+	<dfInputTextArea ref="prose" rows="10" cols="50" class="form-control textarea">
+	  <prose/>This is a test!
+	</dfInputTextArea>
       </div>
     </div>
 
@@ -36,4 +38,13 @@
 
   </dfForm>
 
+  <!--Hack because can't otherwise get default text into dfInputTextArea -->
+  <p class="textLoad" hidden="true"><prose/></p>
+  <script> 
+    $(document).ready(function () {
+      var defaultText = $('.textLoad').text();
+      $('.textarea').text(defaultText);
+    });
+  </script>
+
 </apply>

snaplets/heist/templates/o_comment.tpl

@@ -28,12 +28,23 @@
   </p>
 </reBlock>
 
+
+
 <div class="prose-poster">
   <p>  
     <a href="${prosePosterDestination}">
       <prosePoster/>
-    </a> <proseTimeSince/>.
-    <a href="${discussionUrl}">Discuss (<nDiscussionPoints/>)</a>
+    </a> <proseTimeSince/>
+    <editBlock>
+      <button class="btn btn-default btn-xs">
+      <a href="${editURL}">Edit <span class="glyphicon glyphicon-pencil"></span></a>
+      </button>
+    </editBlock>
+    <button class="btn btn-default btn-xs">
+      <a href="${discussionUrl}">Discuss (<nDiscussionPoints/>)
+	<span class="glyphicon glyphicon-comment"></span>
+      </a>
+    </button>
   </p>
 
 </div>

snaplets/heist/templates/paperBlock.tpl

@@ -1,4 +1,4 @@
-<a href="/view_article/${idNum}">
+<a href="/view_article?paperid=${idNum}">
   <div class="pr_paper">
 
     <apply template="score_block"/>

src/Reffit/AcidTypes.hs

@@ -103,8 +103,8 @@ addCommentDiscussionPoint dp parent' doc commentId comment =
 
 
 addOComment :: Maybe User -> DocumentId -> OverviewComment
-            -> Update PersistentState (Maybe OverviewCommentId)
-addOComment user' pId comment = do
+            -> Maybe OverviewCommentId -> Update PersistentState (Maybe OverviewCommentId)
+addOComment user' pId comment cId' = do
   docs <- gets _documents
   case Map.lookup pId docs of
     Nothing -> return Nothing -- TODO - how to signal error?
@@ -119,8 +119,10 @@ addOComment user' pId comment = do
         Nothing -> return ()
       return (Just cId)
       where
-        cId = head . filter (\k -> Map.notMember k (docOComments doc)) $
-              (cHash:cInd:cAll)
+        cId = case cId' of 
+          Just n -> n
+          Nothing -> head . filter (\k -> Map.notMember k (docOComments doc)) $
+                     (cHash:cInd:cAll)
         cHash = abs . fromIntegral . hash $ T.unpack (ocText comment) ++
                 show (ocPostTime comment)
         cInd  = fromIntegral . Map.size $ docOComments doc

src/Reffit/Handlers/HandleNewOComment.hs

@@ -9,6 +9,7 @@ where
 
 import           Reffit.Types
 import           Reffit.AcidTypes
+import           Reffit.Document
 import           Reffit.OverviewComment
 import           Reffit.User
 
@@ -54,10 +55,18 @@ newOCommentForm formUser ocType t =
       Criticism -> (Just . (,DownVote)) <$> critiqueVoteVal
     critiqueVoteVal = "dimension" .: choice dimOpts Nothing
 
-handleNewOComment :: OverviewCommentType -> Handler App (AuthManager App) ()
+handleNewOComment :: OverviewCommentType ->
+                     Handler App (AuthManager App) ()
 handleNewOComment commentType = do
   userMap <- query QueryAllUsers
+  docMap  <- query QueryAllDocs
   pId'    <- getParam "paperid"
+  cId'    <- getParam "commentid"
+  let oldComment' = join $ join $ 
+                    liftA2 (\dId cId -> (Map.lookup cId . docOComments) <$>
+                                        (Map.lookup dId docMap))
+                    (join $ readMay . BS.unpack <$> pId' :: (Maybe DocumentId))
+                    (join $ readMay . BS.unpack <$> cId' :: Maybe OverviewCommentId)
   authUser' <- currentUser
   t         <- liftIO $ getCurrentTime
   case join $ readMay . T.unpack . decodeUtf8 <$> pId' of
@@ -66,17 +75,29 @@ handleNewOComment commentType = do
       case join $ (Map.lookup <$> (userLogin <$> authUser') <*> pure userMap) of
         Nothing -> writeText $ "handleNewOComment - didn't find user in database"
         Just user -> do
-          (vw,rs) <- runForm "newOCommentForm" $ newOCommentForm user commentType t -- What is this?
+          (vw,rs) <- runForm "newOCommentForm" $ newOCommentForm user commentType t
           case rs of
             Just comment -> do
-              let user' = maybe Nothing (const $ Just user) (ocPoster comment)
-              _ <- update $ AddOComment user' pId comment
-              redirect . BS.pack $ "/view_article/" ++ show pId
+              let user' = maybe Nothing (const $ Just user) (ocPoster comment) -- TODO what's this?
+              _ <- update $ AddOComment user' pId comment (join $ readMay . BS.unpack <$> cId')
+              redirect . BS.pack $ "/view_article?paperid=" ++ show pId
             Nothing -> do
-              heistLocal (bindDigestiveSplices vw) $
-                renderWithSplices "new_o_comment" (oCommentFormSplices commentType)
+              case ( ((join $ ocPoster <$> oldComment') == Just (userName user)) ||
+                     (oldComment' == Nothing) ) of
+                True -> 
+                  heistLocal (bindDigestiveSplices vw) $
+                  renderWithSplices "new_o_comment"
+                  (oCommentFormSplices commentType oldComment' (userName user))
+                False ->
+                  writeText "Author editor name mismatch"
 
-oCommentFormSplices :: Monad m => OverviewCommentType -> Splices (I.Splice m)
-oCommentFormSplices Summary' = do
-  "reBlock" ## I.textSplice ""
-oCommentFormSplices _ = return ()
+oCommentFormSplices :: Monad m => OverviewCommentType -> Maybe OverviewComment -> UserName ->
+                       Splices (I.Splice m)
+oCommentFormSplices commentType oldComment' uname = do
+  when (commentType == Summary') ("reBlock" ## I.textSplice "")
+  "poster" ## I.textSplice (maybe "TEST" (\oc -> maybe "Anonymous" id (ocPoster oc)) oldComment')
+  "posterDisabled" ## I.textSplice (maybe "" (const "disabled") oldComment')
+  "value" ## I.textSplice (maybe "Novelty"
+                           (\oc -> maybe "IMPOSSIBLE" (T.pack . show . fst) (ocVote oc))
+                           oldComment')
+  "prose" ## I.textSplice (maybe "" ocText oldComment')

src/Reffit/Handlers/HandleNewPaper.hs

@@ -136,7 +136,7 @@ handleNewArticle = handleForm
              let doc' = doc {docId = newId}
                  user' = maybe Nothing (const $ Just user) (docUploader doc')
              _ <- update $ AddDocument user' doc'
-             redirect . BS.pack $ "/view_article/" ++ (show . docId $ doc')
+             redirect . BS.pack $ "/view_article?paperid=" ++ (show . docId $ doc')
              where
                newId = head . filter (\k -> Map.notMember k docs)
                        $ (tHash: tLen: tNotTaken)

src/Reffit/Handlers/HandleViewPaper.hs

@@ -111,6 +111,7 @@ allArticleViewSplices u us doc docs t = do
   "userRep"                 ## I.textSplice $ maybe ""
     (T.pack . show . userReputation docs) u
   "articleSummarySummary"   ## I.textSplice (summarySummary doc) :: Splices (SnapletISplice App)
+  "articleURL"              ## I.textSplice (docLink doc)
   "articlePraiseSummary"    ## I.textSplice (critiqueSummary  doc UpVote) :: Splices (SnapletISplice App)
   "articleCriticismSummary" ## I.textSplice (critiqueSummary doc DownVote) :: Splices (SnapletISplice App)
   "nSummaries"              ## I.textSplice (T.pack . show $ nSummaries doc)
@@ -205,9 +206,20 @@ splicesFromOComment t ct viewingU us doc docs (cId,c) = do
         lookupUName = Map.lookup uName us
   case viewingU of
     Nothing -> do
-      "upBtnUrl"   ## I.textSplice "/login"
-      "downBtnUrl" ## I.textSplice "/login"
-    Just user ->
+      "upBtnUrl"   ## I.textSplice "#"
+      "downBtnUrl" ## I.textSplice "#"
+      "editBlock"  ## I.textSplice ""
+    Just user -> do
+      when (Just (userName user) /= ocPoster c)
+        ("editBlock" ## I.textSplice "")
+      when (Just (userName user) == ocPoster c) $ do
+        let commTypeStr = case ocVote c of
+              Nothing ->           "summary"
+              Just (_,DownVote) -> "criticism"
+              Just (_,UpVote)   -> "praise"
+            pIdText = T.pack . show . docId $ doc :: T.Text
+            cIdText = T.pack . show $ cId :: T.Text
+        "editURL" ## I.textSplice (T.concat ["new_", commTypeStr, "?paperid=", pIdText, "&commentid=", cIdText])
       case userCommentRelation user doc cId of
         (Just AnonVoted) -> do
           "upBtnUrl" ## I.textSplice "#"

src/Reffit/Handlers/HandleViewUser.hs

@@ -74,7 +74,7 @@ handlePin doPin = do
       Nothing -> writeBS "Param error" --TODO error page
       Just dId -> do
         _ <- update $ Pin user dId doPin t
-        redirect . BS.pack $ "/view_article/" ++ (show dId)
+        redirect . BS.pack $ "/view_article?paperid=" ++ (show dId)
 
 handleViewUser :: Handler App (AuthManager App) ()
 handleViewUser = do

src/Reffit/OverviewComment.hs

@@ -32,7 +32,7 @@ data OverviewComment = OverviewComment
                        , ocResponse :: [UpDownVote]
                        , ocPostTime :: UTCTime
                        , ocDiscussion :: Discussion
-                       } deriving (Show, Generic)
+                       } deriving (Eq, Show, Generic)
 deriveSafeCopy 1 'extension ''OverviewComment
 
 instance Serialize OverviewComment where

src/Site.hs

@@ -88,6 +88,8 @@ handleNewUser = method GET handleForm <|> method POST handleFormSubmit
             Just _ -> do
               writeText "Username is taken" -- TODO - give a helpful error message: uname is taken
 
+
+------------------------------------------------------------------------------
 handleDumpState :: Handler App (AuthManager App) ()
 handleDumpState = do
   d <- query QueryAllDocs
@@ -107,19 +109,20 @@ routes =
   , ("search"                          , with auth  handleIndex)
   , ("new_article"                     , with auth handleNewArticle)
   , ("new_article/:doi"                , with auth handleNewArticle)
-  , ("new_summary/:paperid"            , with auth (handleNewOComment Summary'))
-  , ("new_praise/:paperid"             , with auth (handleNewOComment Praise))
-  , ("new_criticism/:paperid"          , with auth (handleNewOComment Criticism))
-  , ("view_article/:paperid"           , with auth handleViewPaper)
+  , ("new_summary/"                    , with auth (handleNewOComment Summary'))
+  , ("edit_summary/"                   , with auth (handleNewOComment Summary'))
+  , ("new_praise/"                     , with auth (handleNewOComment Praise))
+  , ("new_criticism/"                  , with auth (handleNewOComment Criticism))
+  , ("view_article/"                   , with auth handleViewPaper)
   , ("cast_ocomment_upvote/:idParam"   , with auth (handleOCommentVote  UpVote))
   , ("cast_ocomment_downvote/:idParam" , with auth (handleOCommentVote  DownVote))
   , ("view_discussion", with auth (method GET handleViewDiscussion <|>
                                    method POST handleAddDiscussion))
   , ("user/:username"                  , with auth handleViewUser)
   , ("follow/:username"                , with auth (handleFollow True))
   , ("unfollow/:username"              , with auth (handleFollow False))
-  , ("pin/:paperid"                    , with auth (handlePin True))
-  , ("unpin/:paperid"                  , with auth (handlePin False))
+  , ("pin/"                            , with auth (handlePin True))
+  , ("unpin/"                          , with auth (handlePin False))
   , ("/add_usertag/:fieldtag"          , with auth (handleAddTag True))
   , ("/delete_usertag/:fieldtag"       , with auth (handleAddTag False))
   , ("/about"                          , render "about")