more

Author: joelmccracken

src/Handler/Admin.hs

@@ -49,7 +49,14 @@ data AbstractTypeForm =
   , abstractTypeFormDuration :: Word64
   } deriving Show
 
-mkAbstractTypeForm :: Maybe Text -> Maybe Int -> Form AbstractTypeForm
+-- TODO have this function take abstract type and make a form for editing
+-- not sure if this should include the ID(?) probably not
+-- - seems like the id is not used in the "new" form
+-- so we don't need Entitity AbsTyp, only AbsTyp
+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
@@ -91,6 +98,27 @@ renderConferenceAbstractTypes conf@(Entity conferenceId _)
           <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
 getConferenceAbstractTypesR conferenceId = do
   (_, _, _, conference) <-
@@ -114,28 +142,34 @@ postConferenceAbstractTypesR conferenceId = do
       renderConferenceAbstractTypes conference abstractTypes abstractTypeFormWidget
     _ -> error "bluhhh"
 
+-- TODO finish making this handler
 getConferenceAbstractTypeR :: ConferenceId -> AbstractTypeId -> Handler Html
 getConferenceAbstractTypeR conferenceId abstractTypeId = do
-  -- (_, _, _, conference) <-
-  --   requireOwnerForConference conferenceId
-  abstractType <- runDB $ getAbstractType abstractTypeId
-  (abstractTypeFormWidget, _) <- generateFormPost abstractTypeForm
-  renderConferenceAbstractTypes conference abstractTypes abstractTypeFormWidget
-
-postConferenceAbstractTypeR :: ConferenceId -> AbstractTypeId -> Handler Html
-postConferenceAbstractTypeR conferenceId abstractTypeId = do
   (_, _, _, conference) <-
     requireOwnerForConference conferenceId
-  ((result, abstractTypeFormWidget), _) <- runFormPost abstractTypeForm
-  case result of
-    FormSuccess (AbstractTypeForm name duration) -> do
-      abstractTypes <- runDB $ do
-        void $
-          insertEntity $
-          AbstractType (entityKey conference) name (makeTalkDuration duration)
-        getAbstractTypes (entityKey conference)
-      renderConferenceAbstractTypes conference abstractTypes abstractTypeFormWidget
-    _ -> error "bluhhh"
+  abstractType <- runDBOr404 $ getAbstractTypeByConferenceAndId conferenceId abstractTypeId
+  (abstractTypeFormWidget, _) <- generateFormPost (mkAbstractTypeForm' (entityVal abstractType))
+  renderConferenceAbstractType conference abstractType abstractTypeFormWidget
+
+
+-- TODO make this after building the form
+postConferenceAbstractTypeR :: ConferenceId -> AbstractTypeId -> Handler Html
+postConferenceAbstractTypeR conferenceId abstractTypeId = undefined
+
+-- postConferenceAbstractTypeR :: ConferenceId -> AbstractTypeId -> Handler Html
+-- postConferenceAbstractTypeR conferenceId abstractTypeId = do
+--   (_, _, _, conference) <-
+--     requireOwnerForConference conferenceId
+--   ((result, abstractTypeFormWidget), _) <- runFormPost abstractTypeForm
+--   case result of
+--     FormSuccess (AbstractTypeForm name duration) -> do
+--       abstractTypes <- runDB $ do
+--         void $
+--           insertEntity $
+--           AbstractType (entityKey conference) name (makeTalkDuration duration)
+--         getAbstractTypes (entityKey conference)
+--       renderConferenceAbstractTypes conference abstractTypes abstractTypeFormWidget
+--     _ -> error "bluhhh"
 
 renderAbstractTypeEdit :: ConferenceId -> Entity AbstractType -> Widget
 renderAbstractTypeEdit  confId (Entity atId (AbstractType _ name td)) =

src/Model/API.hs

@@ -323,9 +323,13 @@ getAbstractTypes :: ConferenceId -> DB [Entity AbstractType]
 getAbstractTypes conferenceId =
   getRecsByField AbstractTypeConference conferenceId
 
-getAbstractType :: AbstractTypeId -> DB [Entity AbstractType]
-getAbstractType abstractTypeId =
-  getRecsByField AbstractTypeId abstractTypeId
+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)]

src/Model/Types.hs

@@ -118,7 +118,7 @@ renderMarkdown (Markdown md) = do
     Left err -> throwIO (PandocRenderingFailed err md)
     (Right html) -> return html
 
-newtype ConferenceSlug = 
+newtype ConferenceSlug =
   ConferenceSlug { unConferenceSlug :: Text }
   deriving (Eq, Show, Read, PathPiece, PersistField, PersistFieldSql)
 
@@ -130,5 +130,5 @@ makeConferenceSlug = ConferenceSlug
 defaultConferenceSlug :: Text -> ConferenceSlug
 defaultConferenceSlug = makeConferenceSlug . filter ( /= ' ')
 
-displayConferenceSlug :: ConferenceSlug -> Text 
+displayConferenceSlug :: ConferenceSlug -> Text
 displayConferenceSlug = decodeUtf8 . urlEncode False . encodeUtf8 . unConferenceSlug