use named record constructors
This commit is contained in:
parent
4a574287b9
commit
f6096921f8
|
@ -30,18 +30,26 @@ getAddViewR = do
|
||||||
bookmarkFormUrl :: Handler BookmarkForm
|
bookmarkFormUrl :: Handler BookmarkForm
|
||||||
bookmarkFormUrl = do
|
bookmarkFormUrl = do
|
||||||
Entity _ user <- requireAuth
|
Entity _ user <- requireAuth
|
||||||
|
url <- lookupGetParam "url" >>= pure . fromMaybe ""
|
||||||
|
title <- lookupGetParam "title"
|
||||||
|
description <- lookupGetParam "description" >>= pure . fmap Textarea
|
||||||
|
tags <- lookupGetParam "tags"
|
||||||
|
private <- lookupGetParam "private" >>= pure . fmap parseChk <&> (<|> Just (userPrivateDefault user))
|
||||||
|
toread <- lookupGetParam "toread" >>= pure . fmap parseChk
|
||||||
|
pure $
|
||||||
BookmarkForm
|
BookmarkForm
|
||||||
<$> (lookupGetParam "url" >>= pure . fromMaybe "")
|
{ _url = url
|
||||||
<*> (lookupGetParam "title")
|
, _title = title
|
||||||
<*> (lookupGetParam "description" >>= pure . fmap Textarea)
|
, _description = description
|
||||||
<*> (lookupGetParam "tags")
|
, _tags = tags
|
||||||
<*> (lookupGetParam "private" >>= pure . fmap parseChk <&> (<|> Just (userPrivateDefault user)))
|
, _private = private
|
||||||
<*> (lookupGetParam "toread" >>= pure . fmap parseChk)
|
, _toread = toread
|
||||||
<*> pure Nothing
|
, _bid = Nothing
|
||||||
<*> pure Nothing
|
, _slug = Nothing
|
||||||
<*> pure Nothing
|
, _selected = Nothing
|
||||||
<*> pure Nothing
|
, _time = Nothing
|
||||||
<*> pure Nothing
|
, _archiveUrl = Nothing
|
||||||
|
}
|
||||||
where
|
where
|
||||||
parseChk s = s == "yes" || s == "on"
|
parseChk s = s == "yes" || s == "on"
|
||||||
|
|
||||||
|
|
|
@ -69,7 +69,7 @@ getAddNoteViewR :: UserNameP -> Handler Html
|
||||||
getAddNoteViewR unamep@(UserNameP uname) = do
|
getAddNoteViewR unamep@(UserNameP uname) = do
|
||||||
userId <- requireAuthId
|
userId <- requireAuthId
|
||||||
let renderEl = "note" :: Text
|
let renderEl = "note" :: Text
|
||||||
note <- liftIO $ Entity (NoteKey 0) <$> _toNote userId (NoteForm Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing)
|
note <- liftIO $ Entity (NoteKey 0) <$> _toNote userId emptyNoteForm
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
$(widgetFile "note")
|
$(widgetFile "note")
|
||||||
toWidgetBody [julius|
|
toWidgetBody [julius|
|
||||||
|
@ -129,6 +129,9 @@ instance ToJSON NoteForm where toJSON = A.genericToJSON gNoteFormOptions
|
||||||
gNoteFormOptions :: A.Options
|
gNoteFormOptions :: A.Options
|
||||||
gNoteFormOptions = A.defaultOptions { A.fieldLabelModifier = drop 1 }
|
gNoteFormOptions = A.defaultOptions { A.fieldLabelModifier = drop 1 }
|
||||||
|
|
||||||
|
emptyNoteForm :: NoteForm
|
||||||
|
emptyNoteForm = NoteForm Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||||
|
|
||||||
_toNote :: UserId -> NoteForm -> IO Note
|
_toNote :: UserId -> NoteForm -> IO Note
|
||||||
_toNote userId NoteForm {..} = do
|
_toNote userId NoteForm {..} = do
|
||||||
time <- liftIO getCurrentTime
|
time <- liftIO getCurrentTime
|
||||||
|
|
12
src/Model.hs
12
src/Model.hs
|
@ -694,12 +694,12 @@ _toBookmark userId BookmarkForm {..} = do
|
||||||
{ bookmarkUserId = userId
|
{ bookmarkUserId = userId
|
||||||
, bookmarkSlug = slug
|
, bookmarkSlug = slug
|
||||||
, bookmarkHref = _url
|
, bookmarkHref = _url
|
||||||
, bookmarkDescription = (fromMaybe "" _title)
|
, bookmarkDescription = fromMaybe "" _title
|
||||||
, bookmarkExtended = (maybe "" unTextarea _description)
|
, bookmarkExtended = maybe "" unTextarea _description
|
||||||
, bookmarkTime = (fromMaybe time (fmap unUTCTimeStr _time))
|
, bookmarkTime = fromMaybe time (fmap unUTCTimeStr _time)
|
||||||
, bookmarkShared = (maybe True not _private)
|
, bookmarkShared = maybe True not _private
|
||||||
, bookmarkToRead = (fromMaybe False _toread)
|
, bookmarkToRead = fromMaybe False _toread
|
||||||
, bookmarkSelected = (fromMaybe False _selected)
|
, bookmarkSelected = fromMaybe False _selected
|
||||||
, bookmarkArchiveHref = _archiveUrl
|
, bookmarkArchiveHref = _archiveUrl
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue