{-# OPTIONS_GHC -fno-warn-unused-matches #-} module Handler.Add where import Import import Database.Persist.Sql import Data.List (nub) import qualified Data.Time.ISO8601 as TI getAddR :: Handler Html getAddR = do userId <- requireAuthId murl <- lookupGetParam "url" mexisting <- runDB $ runMaybeT $ do bmark <- MaybeT . getBy . UniqueUserHref userId =<< (MaybeT $ pure murl) btags <- MaybeT $ Just <$> withTags (entityKey bmark) pure (bmark, btags) mgetdefs <- aFormToMaybeGetSuccess (mkAddAForm Nothing) (formWidget, _) <- generateFormPost $ renderTable $ mkAddAForm (maybe mgetdefs (Just . toAddDefs) mexisting) viewAddWidget formWidget (mexisting $> $(widgetFile "add-exists-alert")) (maybe "url" (const "tags") murl :: Text) where toAddDefs :: (Entity Bookmark, [Entity BookmarkTag]) -> AddForm toAddDefs (Entity bid Bookmark {..}, tags) = AddForm { url = bookmarkHref , title = Just bookmarkDescription , description = Just $ Textarea $ bookmarkExtended , tags = Just $ unwords $ fmap (bookmarkTagTag . entityVal) tags , private = Just $ not bookmarkShared , toread = Just $ bookmarkToRead , bid = Nothing } postAddR :: Handler Html postAddR = do userId <- requireAuthId ((formResult, formWidget), _) <- runFormPost $ renderTable $ mkAddAForm Nothing case formResult of FormSuccess addForm -> do time <- liftIO getCurrentTime newBid <- runDB $ upsertDB (toSqlKey <$> bid addForm) (toBookmark userId time addForm) (maybe [] (nub . words) (tags addForm)) lookupGetParam "next" >>= \case Just next -> redirect next Nothing -> popupLayout Nothing [whamlet|