From fbbe6a48846f7c24f5ddef52fa3d405709bf7a7a Mon Sep 17 00:00:00 2001
From: Joel McCracken <mccracken.joel@gmail.com>
Date: Sun, 28 Oct 2018 00:49:07 -0400
Subject: [PATCH 1/2] implement editing of AbstractType

---
 src/Handler/Admin.hs | 77 +++++++++++++++++++++++++++++++++++++++++---
 src/Model/API.hs     | 16 +++++++++
 src/Routes.hs        |  1 +
 3 files changed, 89 insertions(+), 5 deletions(-)

diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 8142753..3c0d4a9 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -49,14 +49,21 @@ data AbstractTypeForm =
   , abstractTypeFormDuration :: Word64
   } deriving Show
 
-abstractTypeForm :: Form AbstractTypeForm
-abstractTypeForm =
+mkAbstractTypeForm' :: AbstractType -> Form AbstractTypeForm
+mkAbstractTypeForm' at = mkAbstractTypeForm (Just $ abstractTypeName at) (Just $ (unpackTalkDuration . abstractTypeDuration) at)
+
+mkAbstractTypeForm :: Maybe Text -> Maybe Word64 -> Form AbstractTypeForm
+mkAbstractTypeForm atName atDuration =
   renderDivs $
         AbstractTypeForm
     <$> areq textField (named "talk-type-name"
-                        (placeheld "Talk type name: ")) Nothing
+                        (placeheld "Talk type name: "))
+        atName
     <*> areq intField (named "talk-duration"
-                        (placeheld "Talk type duration in minutes: ")) Nothing
+                        (placeheld "Talk type duration in minutes: "))
+        atDuration
+
+abstractTypeForm = mkAbstractTypeForm Nothing Nothing
 
 renderConferenceAbstractTypes ::
      Entity Conference
@@ -84,7 +91,28 @@ renderConferenceAbstractTypes conf@(Entity conferenceId _)
     $else
       <ul>
         $forall abstractType <- abstractTypes
-          <li>#{renderAbstractType (entityVal abstractType)}
+          <li>^{renderAbstractTypeEdit conferenceId abstractType}
+    |]
+
+renderConferenceAbstractType ::
+     Entity Conference
+  -> Entity AbstractType
+  -> Widget
+  -> Handler Html
+renderConferenceAbstractType conf@(Entity conferenceId _)
+  abstractType@(Entity abstractTypeId _) abstractTypeFormWidget = do
+  baseLayout Nothing $ do
+    setTitle "Conference Abstract Type"
+    [whamlet|
+<article .grid-container>
+  <div .medium-3 .cell>
+    ^{renderConferenceWidget conf}
+  <div .medium-3 .cell>
+    <h1> Edit abstract type
+    <div>
+      <form method="POST" action=@{ConferenceAbstractTypeR conferenceId abstractTypeId }>
+        ^{abstractTypeFormWidget}
+        <input .button type="submit" value="Create">
     |]
 
 getConferenceAbstractTypesR :: ConferenceId -> Handler Html
@@ -110,6 +138,45 @@ postConferenceAbstractTypesR conferenceId = do
       renderConferenceAbstractTypes conference abstractTypes abstractTypeFormWidget
     _ -> error "bluhhh"
 
+getConferenceAbstractTypeR :: ConferenceId -> AbstractTypeId -> Handler Html
+getConferenceAbstractTypeR conferenceId abstractTypeId = do
+  (_, _, _, conference) <-
+    requireOwnerForConference conferenceId
+  abstractType <- runDBOr404 $ getAbstractTypeByConferenceAndId conferenceId abstractTypeId
+  (abstractTypeFormWidget, _) <- generateFormPost (mkAbstractTypeForm' (entityVal abstractType))
+  renderConferenceAbstractType conference abstractType abstractTypeFormWidget
+
+postConferenceAbstractTypeR :: ConferenceId -> AbstractTypeId -> Handler Html
+postConferenceAbstractTypeR confId abstractTypeId = do
+  (_, Entity _ conference) <-
+    requireAdminForConference confId
+  abstractType <-
+    runDBOr404 $ get abstractTypeId
+  ((result, widget), enctype) <-
+    runFormPost
+      (mkAbstractTypeForm' abstractType)
+  case result of
+    FormSuccess (AbstractTypeForm name duration) -> do
+      runDB $ updateAbstractType abstractTypeId name duration
+      abstractTypes <- runDB $ getAbstractTypes confId
+      (abstractTypeFormWidget, _) <- generateFormPost abstractTypeForm
+      renderConferenceAbstractTypes
+        (Entity confId conference)
+        abstractTypes abstractTypeFormWidget
+    _ ->
+      renderConferenceAbstractType
+        (Entity confId conference)
+        (Entity abstractTypeId abstractType) widget
+
+renderAbstractTypeEdit :: ConferenceId -> Entity AbstractType -> Widget
+renderAbstractTypeEdit  confId (Entity atId (AbstractType _ name td)) =
+  [whamlet|
+    <label>
+      #{name} (#{renderTalkDuration td})
+    <a href=@{ConferenceAbstractTypeR confId atId}>
+      [Edit]
+  |]
+
 renderConferencesCallout :: [Entity Conference] -> Text -> Widget
 renderConferencesCallout [] _ = return ()
 renderConferencesCallout xs label =
diff --git a/src/Model/API.hs b/src/Model/API.hs
index 2d167b6..02c977a 100644
--- a/src/Model/API.hs
+++ b/src/Model/API.hs
@@ -323,6 +323,14 @@ getAbstractTypes :: ConferenceId -> DB [Entity AbstractType]
 getAbstractTypes conferenceId =
   getRecsByField AbstractTypeConference conferenceId
 
+getAbstractTypeByConferenceAndId :: ConferenceId -> AbstractTypeId -> DB (Maybe (Entity AbstractType))
+getAbstractTypeByConferenceAndId confId atId =
+  selectFirst $
+    from $ \(abstractType) -> do
+      where_ (abstractType ^. AbstractTypeConference ==. val confId)
+      where_ (abstractType ^. AbstractTypeId ==. val atId)
+      pure abstractType
+
 getAbstractsForConference :: ConferenceId
                           -> DB [(Entity Abstract, Entity AbstractType)]
 getAbstractsForConference conferenceId =
@@ -451,6 +459,14 @@ getAbstractsAndAuthorsForConference''' constraints blocked conferenceId offsetAn
                limit lim
     pure (resultF abstract user abstractType)
 
+updateAbstractType :: AbstractTypeId -> Text -> Word64 -> DB ()
+updateAbstractType abstractTypeId name duration =
+  update $ \a -> do
+     set a [ AbstractTypeName =. val name
+           , AbstractTypeDuration =. val (makeTalkDuration duration)
+           ]
+     where_ (a ^. AbstractTypeId ==. val abstractTypeId)
+
 updateAbstract :: AbstractId -> Text -> Markdown -> DB ()
 updateAbstract abstractId title body = do
   update $ \a -> do
diff --git a/src/Routes.hs b/src/Routes.hs
index 27dd946..eb3483b 100644
--- a/src/Routes.hs
+++ b/src/Routes.hs
@@ -28,6 +28,7 @@ mkYesodData "App" [parseRoutes|
 /conference/#ConferenceId/cfp/open                       ConferenceCfpOpenR POST
 /conference/#ConferenceId/cfp/close                      ConferenceCfpCloseR POST
 /conference/#ConferenceId/abstract-types                 ConferenceAbstractTypesR GET POST
+/conference/#ConferenceId/abstract-type/#AbstractTypeId  ConferenceAbstractTypeR GET POST
 /conference/#ConferenceId/cfp                            ConferenceCallForProposalsR GET
 /conference/#ConferenceId/cfp/blocklisted                ConferenceBlockedProposalsR GET
 /conference/#ConferenceId/abstract/#AbstractId           ConferenceAbstractR GET POST

From 3c81f9f71700a27469f2a4ab22c6013d339f9eba Mon Sep 17 00:00:00 2001
From: Joel McCracken <mccracken.joel@gmail.com>
Date: Sun, 28 Oct 2018 00:49:46 -0400
Subject: [PATCH 2/2] whitespace

---
 src/Handler/Admin.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 3c0d4a9..5797965 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -557,18 +557,18 @@ getConferenceCallForProposalsR confId = do
   let filters abstractType abstract user =
         genFilterConstraints cfpFilterF abstractType abstract user
       -- | unblocked abstracts only
-      getAbstractCnt = 
+      getAbstractCnt =
         fmap (fromIntegral . fromMaybe 0 . fmap unValue) . selectFirst $
            getAbstractsAndAuthorsForConferenceCnt filters False confId
       getAbstractPages offs =
         select $
           -- unblocked abstracts only
           getAbstractsAndAuthorsForConferencePage filters False confId (OffsetAndLimit offs pageSize)
-             
-  (itemsCnt, abstractPages) <- runDB $ PageUtil.paginateCustom pageSize 
+
+  (itemsCnt, abstractPages) <- runDB $ PageUtil.paginateCustom pageSize
                          getAbstractCnt
                          (\pn -> getAbstractPages . fromIntegral . PageUtil.pageOffset pn $ pageSize)
-  let abstractCnt = fromIntegral itemsCnt :: Integer                      
+  let abstractCnt = fromIntegral itemsCnt :: Integer
   let abstracts = Page.pageItems (Page.pagesCurrent abstractPages)
   let ct = encodeCellTable [] (colonnadeAbstracts confId) abstracts
       pages = Page.simple pageSize abstractPages
@@ -773,16 +773,16 @@ postConferenceAbstractR confId abstractId = do
 
 -------------------------------------------------------
 -- Proof of concept slug versions
--- Note to do a good job these should have used withConferenceSlugRedirect2 and 
--- withConferenceSlugStrict2 an I should have changed existing rendering functions 
+-- Note to do a good job these should have used withConferenceSlugRedirect2 and
+-- withConferenceSlugStrict2 an I should have changed existing rendering functions
 -- (so they know ConferenceSlug for form submission route)
 -------------------------------------------------------
 getConferenceAbstractPocR :: ConferenceSlug -> AbstractId -> Handler Html
-getConferenceAbstractPocR code abstractId = 
+getConferenceAbstractPocR code abstractId =
    withConferenceSlugRedirect (\c -> ConferenceAbstractPocR c abstractId) (flip getConferenceAbstractR abstractId) code
 
 postConferenceAbstractPocR :: ConferenceSlug -> AbstractId -> Handler Html
-postConferenceAbstractPocR code abstractId = 
+postConferenceAbstractPocR code abstractId =
    withConferenceSlugStrict (flip postConferenceAbstractR abstractId) code
 
 getUserSearchR :: Text -> Handler A.Value