hls lint
This commit is contained in:
Jon Schoning
Yann Esposito (Yogsototh)
parent
2f7db922fa
commit
30fa32897a
GPG key ID:
7B19A4C650D59646
|
|
@ -12,7 +12,7 @@ getAddViewR = do
|
|||
userId <- requireAuthId
|
||||
|
||||
murl <- lookupGetParam "url"
|
||||
mformdb <- runDB (pure . fmap _toBookmarkForm =<< fetchBookmarkByUrl userId murl)
|
||||
mformdb <- runDB (fmap _toBookmarkForm <$> fetchBookmarkByUrl userId murl)
|
||||
formurl <- bookmarkFormUrl
|
||||
|
||||
let renderEl = "addForm" :: Text
|
||||
|
|
@ -31,12 +31,12 @@ getAddViewR = do
|
|||
bookmarkFormUrl :: Handler BookmarkForm
|
||||
bookmarkFormUrl = do
|
||||
Entity _ user <- requireAuth
|
||||
url <- lookupGetParam "url" >>= pure . fromMaybe ""
|
||||
url <- lookupGetParam "url" <&> fromMaybe ""
|
||||
title <- lookupGetParam "title"
|
||||
description <- lookupGetParam "description" >>= pure . fmap Textarea
|
||||
description <- lookupGetParam "description" <&> fmap Textarea
|
||||
tags <- lookupGetParam "tags"
|
||||
private <- lookupGetParam "private" >>= pure . fmap parseChk <&> (<|> Just (userPrivateDefault user))
|
||||
toread <- lookupGetParam "toread" >>= pure . fmap parseChk
|
||||
private <- lookupGetParam "private" <&> fmap parseChk <&> (<|> Just (userPrivateDefault user))
|
||||
toread <- lookupGetParam "toread" <&> fmap parseChk
|
||||
pure $
|
||||
BookmarkForm
|
||||
{ _url = url
|
||||
|
|
|
|||
|
|
@ -18,26 +18,26 @@ import Network.Wai (requestHeaderHost)
|
|||
import qualified Network.Connection as NC
|
||||
|
||||
shouldArchiveBookmark :: User -> Key Bookmark -> Handler Bool
|
||||
shouldArchiveBookmark user kbid = do
|
||||
shouldArchiveBookmark user kbid =
|
||||
runDB (get kbid) >>= \case
|
||||
Nothing -> pure False
|
||||
|
||||
Just bm -> do
|
||||
pure $
|
||||
(isNothing $ bookmarkArchiveHref bm) &&
|
||||
(bookmarkShared bm)
|
||||
&& not (_isArchiveBlacklisted bm)
|
||||
&& userArchiveDefault user
|
||||
Nothing -> pure False
|
||||
|
||||
Just bm -> do
|
||||
pure $
|
||||
isNothing (bookmarkArchiveHref bm) &&
|
||||
bookmarkShared bm
|
||||
&& not (_isArchiveBlacklisted bm)
|
||||
&& userArchiveDefault user
|
||||
|
||||
getArchiveManager :: Handler Manager
|
||||
getArchiveManager = do
|
||||
appSettings <- pure . appSettings =<< getYesod
|
||||
appSettings <- appSettings <$> getYesod
|
||||
let mSocks =
|
||||
NC.SockSettingsSimple <$>
|
||||
fmap unpack (appArchiveSocksProxyHost appSettings) <*>
|
||||
fmap toEnum (appArchiveSocksProxyPort appSettings)
|
||||
NH.newTlsManagerWith (NH.mkManagerSettings def mSocks)
|
||||
|
||||
|
||||
|
||||
archiveBookmarkUrl :: Key Bookmark -> String -> Handler ()
|
||||
archiveBookmarkUrl kbid url =
|
||||
|
|
@ -55,13 +55,13 @@ archiveBookmarkUrl kbid url =
|
|||
case status of
|
||||
s | s == NH.status200 ->
|
||||
for_ (lookup "Refresh" headers >>= _parseRefreshHeaderUrl) updateArchiveUrl
|
||||
s | s == NH.status302 || s == NH.status307 ->
|
||||
s | s == NH.status302 || s == NH.status307 ->
|
||||
for_ (lookup "Location" headers) (updateArchiveUrl . decodeUtf8)
|
||||
_ -> $(logError) (pack (show res)))
|
||||
`catch` (\(e::SomeException) -> ($(logError) $ (pack.show) e) >> throwIO e)
|
||||
|
||||
_isArchiveBlacklisted :: Bookmark -> Bool
|
||||
_isArchiveBlacklisted (Bookmark {..}) =
|
||||
_isArchiveBlacklisted Bookmark {..} =
|
||||
[ "hulu"
|
||||
, "livestream"
|
||||
, "netflix"
|
||||
|
|
@ -77,13 +77,13 @@ _isArchiveBlacklisted (Bookmark {..}) =
|
|||
_parseRefreshHeaderUrl :: ByteString -> Maybe Text
|
||||
_parseRefreshHeaderUrl h = do
|
||||
let u = BS8.drop 1 $ BS8.dropWhile (/= '=') h
|
||||
if (not (null u))
|
||||
if not (null u)
|
||||
then Just $ decodeUtf8 u
|
||||
else Nothing
|
||||
|
||||
_fetchArchiveSubmitInfo :: Handler (Either String (String , String))
|
||||
_fetchArchiveSubmitInfo = do
|
||||
req <- buildRequest "https://archive.li/"
|
||||
req <- buildRequest "https://archive.li/"
|
||||
manager <- getArchiveManager
|
||||
res <- liftIO $ NH.httpLbs req manager
|
||||
let body = LBS.toStrict (responseBody res)
|
||||
|
|
@ -92,13 +92,12 @@ _fetchArchiveSubmitInfo = do
|
|||
if statusCode (responseStatus res) == 200
|
||||
then pure $ (,) <$> action <*> submitId
|
||||
else pure $ Left $ "Invalid statusCode: " <> show (responseStatus res)
|
||||
|
||||
|
||||
|
||||
_parseSubstring :: AP8.Parser ByteString -> AP8.Parser Char -> BS.ByteString -> Either String String
|
||||
_parseSubstring start inner res = do
|
||||
(flip AP8.parseOnly) res (skipAnyTill start >> AP8.many1 inner)
|
||||
_parseSubstring start inner = AP8.parseOnly (skipAnyTill start >> AP8.many1 inner)
|
||||
where
|
||||
skipAnyTill end = go where go = end *> pure () <|> AP8.anyChar *> go
|
||||
skipAnyTill end = go where go = end $> () <|> AP8.anyChar *> go
|
||||
|
||||
|
||||
fetchPageTitle :: String -> Handler (Either String Text)
|
||||
|
|
@ -113,23 +112,23 @@ fetchPageTitle url =
|
|||
pure (Left (show e)))
|
||||
where
|
||||
parseTitle bs =
|
||||
(flip AP.parseOnly) bs do
|
||||
flip AP.parseOnly bs do
|
||||
_ <- skipAnyTill (AP.string "<title")
|
||||
_ <- skipAnyTill (AP.string ">")
|
||||
let lt = toEnum (ord '<')
|
||||
AP.takeTill (== lt)
|
||||
decodeHtmlBs = toStrict . toLazyText . htmlEncodedText . decodeUtf8
|
||||
skipAnyTill end = go where go = end *> pure () <|> AP.anyWord8 *> go
|
||||
skipAnyTill end = go where go = end $> () <|> AP.anyWord8 *> go
|
||||
|
||||
_buildArchiveSubmitRequest :: (String, String) -> String -> Handler NH.Request
|
||||
_buildArchiveSubmitRequest (action, submitId) href = do
|
||||
req <- buildRequest ("POST " <> action)
|
||||
req <- buildRequest ("POST " <> action)
|
||||
pure $ req
|
||||
{ NH.requestHeaders = ("Content-Type", "application/x-www-form-urlencoded") : NH.requestHeaders req
|
||||
, NH.requestBody =
|
||||
NH.RequestBodyLBS $
|
||||
WH.urlEncodeAsForm
|
||||
(([("submitid", submitId), ("url", href)]) :: [(String, String)])
|
||||
([("submitid", submitId), ("url", href)] :: [(String, String)])
|
||||
, NH.redirectCount = 0
|
||||
}
|
||||
|
||||
|
|
@ -145,6 +144,6 @@ buildRequest url = do
|
|||
|
||||
_archiveUserAgent :: Handler ByteString
|
||||
_archiveUserAgent = do
|
||||
mHost <- pure . requestHeaderHost . reqWaiRequest =<< getRequest
|
||||
pure $ ("espial-" <>) (maybe "" (BS8.takeWhile (/= ':')) mHost)
|
||||
mHost <- requestHeaderHost . reqWaiRequest <$> getRequest
|
||||
pure $ "espial-" <> maybe "" (BS8.takeWhile (/= ':')) mHost
|
||||
|
||||
|
|
|
|||
|
|
@ -29,8 +29,7 @@ lookupPagingParams =
|
|||
|
||||
getUrlParam :: (Read a) => Text -> Handler (Maybe a)
|
||||
getUrlParam name = do
|
||||
p <- fmap parseMaybe (lookupGetParam name)
|
||||
pure p
|
||||
fmap parseMaybe (lookupGetParam name)
|
||||
where
|
||||
parseMaybe x = readMaybe . unpack =<< x
|
||||
|
||||
|
|
@ -68,4 +67,4 @@ getTagCloudMode isowner tags = do
|
|||
Just (TagCloudModeRelated e _) -> TagCloudModeTop e 200
|
||||
Just m -> m
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -5,5 +5,5 @@ module Handler.Docs where
|
|||
import Import
|
||||
|
||||
getDocsSearchR :: Handler Html
|
||||
getDocsSearchR = popupLayout $
|
||||
getDocsSearchR = popupLayout
|
||||
$(widgetFile "docs-search")
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module Handler.Notes where
|
||||
|
||||
import Import
|
||||
|
|
@ -16,8 +17,8 @@ getNotesR unamep@(UserNameP uname) = do
|
|||
mquery <- lookupGetParam queryp
|
||||
let limit = maybe 20 fromIntegral limit'
|
||||
page = maybe 1 fromIntegral page'
|
||||
mqueryp = fmap (\q -> (queryp, q)) mquery
|
||||
isowner = maybe False (== uname) mauthuname
|
||||
mqueryp = fmap (queryp,) mquery
|
||||
isowner = Just uname == mauthuname
|
||||
(bcount, notes) <- runDB do
|
||||
Entity userId user <- getBy404 (UniqueUserName uname)
|
||||
let sharedp = if isowner then SharedAll else SharedPublic
|
||||
|
|
@ -45,7 +46,7 @@ getNoteR :: UserNameP -> NtSlug -> Handler Html
|
|||
getNoteR unamep@(UserNameP uname) slug = do
|
||||
mauthuname <- maybeAuthUsername
|
||||
let renderEl = "note" :: Text
|
||||
isowner = maybe False (== uname) mauthuname
|
||||
isowner = Just uname == mauthuname
|
||||
note <-
|
||||
runDB $
|
||||
do Entity userId user <- getBy404 (UniqueUserName uname)
|
||||
|
|
@ -143,10 +144,10 @@ _toNote userId NoteForm {..} = do
|
|||
, noteLength = length _text
|
||||
, noteTitle = fromMaybe "" _title
|
||||
, noteText = maybe "" unTextarea _text
|
||||
, noteIsMarkdown = fromMaybe False _isMarkdown
|
||||
, noteShared = fromMaybe False _shared
|
||||
, noteCreated = fromMaybe time (fmap unUTCTimeStr _created)
|
||||
, noteUpdated = fromMaybe time (fmap unUTCTimeStr _updated)
|
||||
, noteIsMarkdown = Just True == _isMarkdown
|
||||
, noteShared = Just True == _shared
|
||||
, noteCreated = maybe time unUTCTimeStr _created
|
||||
, noteUpdated = maybe time unUTCTimeStr _updated
|
||||
}
|
||||
|
||||
noteToRssEntry :: UserNameP -> Entity Note -> FeedEntry (Route App)
|
||||
|
|
@ -167,7 +168,7 @@ getNotesFeedR unamep@(UserNameP uname) = do
|
|||
mquery <- lookupGetParam "query"
|
||||
let limit = maybe 20 fromIntegral limit'
|
||||
page = maybe 1 fromIntegral page'
|
||||
isowner = maybe False (== uname) mauthuname
|
||||
isowner = Just uname == mauthuname
|
||||
(_, notes) <- runDB do
|
||||
Entity userId user <- getBy404 (UniqueUserName uname)
|
||||
when (not isowner && userPrivacyLock user)
|
||||
|
|
@ -176,7 +177,7 @@ getNotesFeedR unamep@(UserNameP uname) = do
|
|||
let (descr :: Html) = toHtml $ H.text (uname <> " notes")
|
||||
entries = map (noteToRssEntry unamep) notes
|
||||
updated <- case maximumMay (map feedEntryUpdated entries) of
|
||||
Nothing -> liftIO $ getCurrentTime
|
||||
Nothing -> liftIO getCurrentTime
|
||||
Just m -> return m
|
||||
rssFeed $
|
||||
Feed
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module Handler.User where
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
|
@ -9,7 +10,7 @@ import Yesod.RssFeed
|
|||
import qualified Data.Map as Map
|
||||
|
||||
getUserR :: UserNameP -> Handler Html
|
||||
getUserR uname@(UserNameP name) = do
|
||||
getUserR uname@(UserNameP name) =
|
||||
_getUser uname SharedAll FilterAll (TagsP [])
|
||||
|
||||
getUserSharedR :: UserNameP -> SharedP -> Handler Html
|
||||
|
|
@ -21,8 +22,7 @@ getUserFilterR uname filterp =
|
|||
_getUser uname SharedAll filterp (TagsP [])
|
||||
|
||||
getUserTagsR :: UserNameP -> TagsP -> Handler Html
|
||||
getUserTagsR uname pathtags =
|
||||
_getUser uname SharedAll FilterAll pathtags
|
||||
getUserTagsR uname = _getUser uname SharedAll FilterAll
|
||||
|
||||
_getUser :: UserNameP -> SharedP -> FilterP -> TagsP -> Handler Html
|
||||
_getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do
|
||||
|
|
@ -30,15 +30,15 @@ _getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do
|
|||
(limit', page') <- lookupPagingParams
|
||||
let limit = maybe 120 fromIntegral limit'
|
||||
page = maybe 1 fromIntegral page'
|
||||
isowner = maybe False (== uname) mauthuname
|
||||
isowner = Just uname == mauthuname
|
||||
sharedp = if isowner then sharedp' else SharedPublic
|
||||
filterp = case filterp' of
|
||||
FilterSingle _ -> filterp'
|
||||
_ -> if isowner then filterp' else FilterAll
|
||||
isAll = filterp == FilterAll && sharedp == SharedAll && pathtags == []
|
||||
isAll = filterp == FilterAll && sharedp == SharedAll && null pathtags
|
||||
queryp = "query" :: Text
|
||||
mquery <- lookupGetParam queryp
|
||||
let mqueryp = fmap (\q -> (queryp, q)) mquery
|
||||
let mqueryp = fmap (queryp,) mquery
|
||||
(bcount, btmarks) <- runDB $ do
|
||||
Entity userId user <- getBy404 (UniqueUserName uname)
|
||||
when (not isowner && userPrivacyLock user)
|
||||
|
|
@ -71,7 +71,7 @@ _getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do
|
|||
|]
|
||||
|
||||
-- Form
|
||||
|
||||
|
||||
postUserTagCloudR :: Handler ()
|
||||
postUserTagCloudR = do
|
||||
userId <- requireAuthId
|
||||
|
|
@ -91,7 +91,7 @@ postUserTagCloudModeR = do
|
|||
_updateTagCloudMode mode
|
||||
|
||||
_updateTagCloudMode :: TagCloudMode -> Handler ()
|
||||
_updateTagCloudMode mode =
|
||||
_updateTagCloudMode mode =
|
||||
case mode of
|
||||
TagCloudModeTop _ _ -> setTagCloudMode mode
|
||||
TagCloudModeLowerBound _ _ -> setTagCloudMode mode
|
||||
|
|
@ -99,7 +99,7 @@ _updateTagCloudMode mode =
|
|||
TagCloudModeNone -> notFound
|
||||
|
||||
bookmarkToRssEntry :: (Entity Bookmark, Maybe Text) -> FeedEntry Text
|
||||
bookmarkToRssEntry ((Entity entryId entry), tags) =
|
||||
bookmarkToRssEntry (Entity entryId entry, tags) =
|
||||
FeedEntry
|
||||
{ feedEntryLink = bookmarkHref entry
|
||||
, feedEntryUpdated = bookmarkTime entry
|
||||
|
|
@ -116,7 +116,7 @@ getUserFeedR unamep@(UserNameP uname) = do
|
|||
let limit = maybe 120 fromIntegral limit'
|
||||
page = maybe 1 fromIntegral page'
|
||||
queryp = "query" :: Text
|
||||
isowner = maybe False (== uname) mauthuname
|
||||
isowner = Just uname == mauthuname
|
||||
mquery <- lookupGetParam queryp
|
||||
(_, btmarks) <- runDB $ do
|
||||
Entity userId user <- getBy404 (UniqueUserName uname)
|
||||
|
|
@ -126,7 +126,7 @@ getUserFeedR unamep@(UserNameP uname) = do
|
|||
let (descr :: Html) = toHtml $ H.text ("Bookmarks saved by " <> uname)
|
||||
entries = map bookmarkToRssEntry btmarks
|
||||
updated <- case maximumMay (map feedEntryUpdated entries) of
|
||||
Nothing -> liftIO $ getCurrentTime
|
||||
Nothing -> liftIO getCurrentTime
|
||||
Just m -> return m
|
||||
render <- getUrlRender
|
||||
rssFeedText $
|
||||
|
|
|
|||
|
|
@ -48,13 +48,13 @@ aFormToMaybeGetSuccess
|
|||
:: MonadHandler f
|
||||
=> AForm f a -> f (Maybe a)
|
||||
aFormToMaybeGetSuccess =
|
||||
fmap maybeSuccess . fmap fst . runFormGet . const . fmap fst . aFormToForm
|
||||
fmap (maybeSuccess . fst) . runFormGet . const . fmap fst . aFormToForm
|
||||
|
||||
aFormToMaybePostSuccess
|
||||
:: MonadHandlerForm f
|
||||
=> AForm f a -> f (Maybe a)
|
||||
aFormToMaybePostSuccess =
|
||||
fmap maybeSuccess . fmap fst . runFormPostNoToken . const . fmap fst . aFormToForm
|
||||
fmap (maybeSuccess . fst) . runFormPostNoToken . const . fmap fst . aFormToForm
|
||||
|
||||
maybeSuccess :: FormResult a -> Maybe a
|
||||
maybeSuccess (FormSuccess a) = Just a
|
||||
|
|
@ -83,4 +83,4 @@ attrs n f =
|
|||
}
|
||||
|
||||
cls :: [Text] -> FieldSettings master -> FieldSettings master
|
||||
cls n = attrs [("class", intercalate " " n)]
|
||||
cls n = attrs [("class", unwords n)]
|
||||
|
|
|
|||
154
src/Model.hs
154
src/Model.hs
|
|
@ -138,12 +138,12 @@ migrateIndexes =
|
|||
, "CREATE INDEX IF NOT EXISTS idx_note_user_created ON note (user_id, created DESC)"
|
||||
]
|
||||
|
||||
sqlite_group_concat ::
|
||||
sqliteGroupConcat ::
|
||||
PersistField a
|
||||
=> SqlExpr (Value a)
|
||||
-> SqlExpr (Value a)
|
||||
-> SqlExpr (Value Text)
|
||||
sqlite_group_concat expr sep = unsafeSqlFunction "GROUP_CONCAT" [expr, sep]
|
||||
sqliteGroupConcat expr sep = unsafeSqlFunction "GROUP_CONCAT" [expr, sep]
|
||||
|
||||
authenticatePassword :: Text -> Text -> DB (Maybe (Entity User))
|
||||
authenticatePassword username password = do
|
||||
|
|
@ -156,7 +156,7 @@ authenticatePassword username password = do
|
|||
else return Nothing
|
||||
|
||||
getUserByName :: UserNameP -> DB (Maybe (Entity User))
|
||||
getUserByName (UserNameP uname) = do
|
||||
getUserByName (UserNameP uname) =
|
||||
selectFirst [UserName CP.==. uname] []
|
||||
|
||||
-- returns a list of pair of bookmark with tags merged into a string
|
||||
|
|
@ -186,12 +186,12 @@ bookmarksTagsQuery userId sharedp filterp tags mquery limit' page =
|
|||
where_ (t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId)
|
||||
groupBy (t ^. BookmarkTagBookmarkId)
|
||||
orderBy [asc (t ^. BookmarkTagSeq)]
|
||||
pure $ sqlite_group_concat (t ^. BookmarkTagTag) (val " ")))
|
||||
pure $ sqliteGroupConcat (t ^. BookmarkTagTag) (val " ")))
|
||||
where
|
||||
_whereClause b = do
|
||||
where_ $
|
||||
foldl (\expr tag ->
|
||||
expr &&. (exists $ -- each tag becomes an exists constraint
|
||||
expr &&. exists ( -- each tag becomes an exists constraint
|
||||
from (table @BookmarkTag) >>= \t ->
|
||||
where_ (t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId &&.
|
||||
(t ^. BookmarkTagTag `like` val tag))))
|
||||
|
|
@ -217,13 +217,12 @@ bookmarksTagsQuery userId sharedp filterp tags mquery limit' page =
|
|||
wild s = (%) ++. val s ++. (%)
|
||||
toLikeB field s = b ^. field `like` wild s
|
||||
p_allFields =
|
||||
(toLikeB BookmarkHref term) ||.
|
||||
(toLikeB BookmarkDescription term) ||.
|
||||
(toLikeB BookmarkExtended term) ||.
|
||||
(exists $ from (table @BookmarkTag) >>= \t -> where_ $
|
||||
toLikeB BookmarkHref term ||.
|
||||
toLikeB BookmarkDescription term ||.
|
||||
toLikeB BookmarkExtended term ||.
|
||||
exists (from (table @BookmarkTag) >>= \t -> where_ $
|
||||
(t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId) &&.
|
||||
(t ^. BookmarkTagTag `like` (wild term))
|
||||
)
|
||||
(t ^. BookmarkTagTag `like` wild term))
|
||||
p_onefield = p_url <|> p_title <|> p_description <|> p_tags <|> p_after <|> p_before
|
||||
where
|
||||
p_url = "url:" *> fmap (toLikeB BookmarkHref) P.takeText
|
||||
|
|
@ -248,8 +247,8 @@ allUserBookmarks user =
|
|||
where_ (t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId)
|
||||
groupBy (t ^. BookmarkTagBookmarkId)
|
||||
orderBy [asc (t ^. BookmarkTagSeq)]
|
||||
pure $ sqlite_group_concat (t ^. BookmarkTagTag) (val " "))
|
||||
|
||||
pure $ sqliteGroupConcat (t ^. BookmarkTagTag) (val " "))
|
||||
|
||||
parseSearchQuery ::
|
||||
(Text -> SqlExpr (Value Bool))
|
||||
-> Text
|
||||
|
|
@ -294,7 +293,7 @@ getNoteList key mquery sharedp limit' page =
|
|||
(select $ do
|
||||
b <- from (table @Note)
|
||||
_whereClause b
|
||||
pure $ countRows)
|
||||
pure countRows)
|
||||
<*> (select $ do
|
||||
b <- from (table @Note)
|
||||
_whereClause b
|
||||
|
|
@ -304,7 +303,7 @@ getNoteList key mquery sharedp limit' page =
|
|||
pure b)
|
||||
where
|
||||
_whereClause b = do
|
||||
where_ $ (b ^. NoteUserId ==. val key)
|
||||
where_ (b ^. NoteUserId ==. val key)
|
||||
-- search
|
||||
sequenceA_ (parseSearchQuery (toLikeExpr b) =<< mquery)
|
||||
case sharedp of
|
||||
|
|
@ -333,7 +332,7 @@ mkBookmarkTags userId bookmarkId tags =
|
|||
|
||||
|
||||
fileBookmarkToBookmark :: UserId -> FileBookmark -> IO Bookmark
|
||||
fileBookmarkToBookmark user (FileBookmark {..}) = do
|
||||
fileBookmarkToBookmark user FileBookmark {..} = do
|
||||
slug <- mkBmSlug
|
||||
pure $
|
||||
Bookmark
|
||||
|
|
@ -345,12 +344,12 @@ fileBookmarkToBookmark user (FileBookmark {..}) = do
|
|||
, bookmarkTime = fileBookmarkTime
|
||||
, bookmarkShared = fileBookmarkShared
|
||||
, bookmarkToRead = fileBookmarkToRead
|
||||
, bookmarkSelected = (fromMaybe False fileBookmarkSelected)
|
||||
, bookmarkSelected = Just True == fileBookmarkSelected
|
||||
, bookmarkArchiveHref = fileBookmarkArchiveHref
|
||||
}
|
||||
|
||||
bookmarkTofileBookmark :: Bookmark -> Text -> FileBookmark
|
||||
bookmarkTofileBookmark (Bookmark {..}) tags =
|
||||
bookmarkTofileBookmark Bookmark {..} tags =
|
||||
FileBookmark
|
||||
{ fileBookmarkHref = bookmarkHref
|
||||
, fileBookmarkDescription = bookmarkDescription
|
||||
|
|
@ -377,7 +376,7 @@ data FFBookmarkNode = FFBookmarkNode
|
|||
, firefoxBookmarkTypeCode :: !Int
|
||||
, firefoxBookmarkUri :: !(Maybe Text)
|
||||
} deriving (Show, Eq, Typeable, Ord)
|
||||
|
||||
|
||||
instance FromJSON FFBookmarkNode where
|
||||
parseJSON (Object o) =
|
||||
FFBookmarkNode <$>
|
||||
|
|
@ -396,7 +395,7 @@ instance FromJSON FFBookmarkNode where
|
|||
parseJSON _ = A.parseFail "bad parse"
|
||||
|
||||
firefoxBookmarkNodeToBookmark :: UserId -> FFBookmarkNode -> IO [Bookmark]
|
||||
firefoxBookmarkNodeToBookmark user (FFBookmarkNode {..}) = do
|
||||
firefoxBookmarkNodeToBookmark user FFBookmarkNode {..} =
|
||||
case firefoxBookmarkTypeCode of
|
||||
1 -> do
|
||||
slug <- mkBmSlug
|
||||
|
|
@ -404,10 +403,10 @@ firefoxBookmarkNodeToBookmark user (FFBookmarkNode {..}) = do
|
|||
[ Bookmark
|
||||
{ bookmarkUserId = user
|
||||
, bookmarkSlug = slug
|
||||
, bookmarkHref = (fromMaybe "" firefoxBookmarkUri)
|
||||
, bookmarkHref = fromMaybe "" firefoxBookmarkUri
|
||||
, bookmarkDescription = firefoxBookmarkTitle
|
||||
, bookmarkExtended = ""
|
||||
, bookmarkTime = (TI.posixSecondsToUTCTime (firefoxBookmarkDateAdded / 1000000))
|
||||
, bookmarkTime = TI.posixSecondsToUTCTime (firefoxBookmarkDateAdded / 1000000)
|
||||
, bookmarkShared = True
|
||||
, bookmarkToRead = False
|
||||
, bookmarkSelected = False
|
||||
|
|
@ -421,7 +420,7 @@ firefoxBookmarkNodeToBookmark user (FFBookmarkNode {..}) = do
|
|||
(fromMaybe [] firefoxBookmarkChildren)
|
||||
_ -> pure []
|
||||
|
||||
|
||||
|
||||
insertFileBookmarks :: Key User -> FilePath -> DB (Either String Int)
|
||||
insertFileBookmarks userId bookmarkFile = do
|
||||
mfmarks <- liftIO $ readFileBookmarks bookmarkFile
|
||||
|
|
@ -430,16 +429,15 @@ insertFileBookmarks userId bookmarkFile = do
|
|||
Right fmarks -> do
|
||||
bmarks <- liftIO $ mapM (fileBookmarkToBookmark userId) fmarks
|
||||
mbids <- mapM insertUnique bmarks
|
||||
void $
|
||||
mapM insertUnique $
|
||||
mapM_ (void . insertUnique) $
|
||||
concatMap (uncurry (mkBookmarkTags userId)) $
|
||||
catMaybes $
|
||||
zipWith
|
||||
(\mbid tags -> ((, tags) <$> mbid))
|
||||
(\mbid tags -> (, tags) <$> mbid)
|
||||
mbids
|
||||
(extractTags <$> fmarks)
|
||||
pure $ Right (length bmarks)
|
||||
|
||||
|
||||
where
|
||||
extractTags = words . fileBookmarkTags
|
||||
|
||||
|
|
@ -450,20 +448,20 @@ insertFFBookmarks userId bookmarkFile = do
|
|||
Left e -> pure $ Left e
|
||||
Right fmarks -> do
|
||||
bmarks <- liftIO $ firefoxBookmarkNodeToBookmark userId fmarks
|
||||
_ <- mapM insertUnique bmarks
|
||||
mapM_ (void . insertUnique) bmarks
|
||||
pure $ Right (length bmarks)
|
||||
|
||||
|
||||
readFileBookmarks :: MonadIO m => FilePath -> m (Either String [FileBookmark])
|
||||
readFileBookmarks fpath =
|
||||
pure . A.eitherDecode' . fromStrict =<< readFile fpath
|
||||
A.eitherDecode' . fromStrict <$> readFile fpath
|
||||
|
||||
readFFBookmarks :: MonadIO m => FilePath -> m (Either String FFBookmarkNode)
|
||||
readFFBookmarks fpath =
|
||||
pure . A.eitherDecode' . fromStrict =<< readFile fpath
|
||||
A.eitherDecode' . fromStrict <$> readFile fpath
|
||||
|
||||
exportFileBookmarks :: Key User -> FilePath -> DB ()
|
||||
exportFileBookmarks user fpath = do
|
||||
exportFileBookmarks user fpath =
|
||||
liftIO . A.encodeFile fpath =<< getFileBookmarks user
|
||||
|
||||
getFileBookmarks :: Key User -> DB [FileBookmark]
|
||||
|
|
@ -489,7 +487,7 @@ instance FromJSON TagCloudMode where
|
|||
case lookup "mode" o of
|
||||
Just (String "top") -> TagCloudModeTop <$> o .: "expanded" <*> o .: "value"
|
||||
Just (String "lowerBound") -> TagCloudModeLowerBound <$> o .: "expanded" <*> o .: "value"
|
||||
Just (String "related") -> TagCloudModeRelated <$> o .: "expanded" <*> (fmap words (o .: "value"))
|
||||
Just (String "related") -> TagCloudModeRelated <$> o .: "expanded" <*> fmap words (o .: "value")
|
||||
Just (String "none") -> pure TagCloudModeNone
|
||||
_ -> A.parseFail "bad parse"
|
||||
parseJSON _ = A.parseFail "bad parse"
|
||||
|
|
@ -515,27 +513,27 @@ instance ToJSON TagCloudMode where
|
|||
, "value" .= Null
|
||||
, "expanded" .= Bool False
|
||||
]
|
||||
|
||||
|
||||
|
||||
|
||||
type Tag = Text
|
||||
|
||||
tagCountTop :: Key User -> Int -> DB [(Text, Int)]
|
||||
tagCountTop user top =
|
||||
tagCountTop user top =
|
||||
sortOn (toLower . fst) .
|
||||
fmap (\(tname, tcount) -> (unValue tname, unValue tcount)) <$>
|
||||
fmap (bimap unValue unValue) <$>
|
||||
( select $ do
|
||||
t <- from (table @BookmarkTag)
|
||||
where_ (t ^. BookmarkTagUserId ==. val user)
|
||||
groupBy (lower_ $ t ^. BookmarkTagTag)
|
||||
let countRows' = countRows
|
||||
orderBy [desc countRows']
|
||||
orderBy [desc countRows']
|
||||
limit ((fromIntegral . toInteger) top)
|
||||
pure $ (t ^. BookmarkTagTag, countRows')
|
||||
pure (t ^. BookmarkTagTag, countRows')
|
||||
)
|
||||
|
||||
tagCountLowerBound :: Key User -> Int -> DB [(Text, Int)]
|
||||
tagCountLowerBound user lowerBound =
|
||||
fmap (\(tname, tcount) -> (unValue tname, unValue tcount)) <$>
|
||||
tagCountLowerBound user lowerBound =
|
||||
fmap (bimap unValue unValue) <$>
|
||||
( select $ do
|
||||
t <- from (table @BookmarkTag)
|
||||
where_ (t ^. BookmarkTagUserId ==. val user)
|
||||
|
|
@ -543,17 +541,17 @@ tagCountLowerBound user lowerBound =
|
|||
let countRows' = countRows
|
||||
orderBy [asc (t ^. BookmarkTagTag)]
|
||||
having (countRows' >=. val lowerBound)
|
||||
pure $ (t ^. BookmarkTagTag, countRows')
|
||||
pure (t ^. BookmarkTagTag, countRows')
|
||||
)
|
||||
|
||||
tagCountRelated :: Key User -> [Tag] -> DB [(Text, Int)]
|
||||
tagCountRelated user tags =
|
||||
fmap (\(tname, tcount) -> (unValue tname, unValue tcount)) <$>
|
||||
tagCountRelated user tags =
|
||||
fmap (bimap unValue unValue) <$>
|
||||
( select $ do
|
||||
t <- from (table @BookmarkTag)
|
||||
where_ $
|
||||
foldl (\expr tag ->
|
||||
expr &&. (exists $ do
|
||||
expr &&. exists ( do
|
||||
u <- from (table @BookmarkTag)
|
||||
where_ (u ^. BookmarkTagBookmarkId ==. t ^. BookmarkTagBookmarkId &&.
|
||||
(u ^. BookmarkTagTag `like` val tag))))
|
||||
|
|
@ -562,13 +560,13 @@ tagCountRelated user tags =
|
|||
groupBy (lower_ $ t ^. BookmarkTagTag)
|
||||
let countRows' = countRows
|
||||
orderBy [asc $ lower_ $ (t ^. BookmarkTagTag)]
|
||||
pure $ (t ^. BookmarkTagTag, countRows')
|
||||
pure (t ^. BookmarkTagTag, countRows')
|
||||
)
|
||||
|
||||
-- Notes
|
||||
|
||||
fileNoteToNote :: UserId -> FileNote -> IO Note
|
||||
fileNoteToNote user (FileNote {..} ) = do
|
||||
fileNoteToNote user FileNote {..} = do
|
||||
slug <- mkNtSlug
|
||||
pure $
|
||||
Note
|
||||
|
|
@ -580,7 +578,7 @@ fileNoteToNote user (FileNote {..} ) = do
|
|||
, noteIsMarkdown = False
|
||||
, noteShared = False
|
||||
, noteCreated = fileNoteCreatedAt
|
||||
, noteUpdated = fileNoteUpdatedAt
|
||||
, noteUpdated = fileNoteUpdatedAt
|
||||
}
|
||||
|
||||
insertDirFileNotes :: Key User -> FilePath -> DB (Either String Int)
|
||||
|
|
@ -610,7 +608,7 @@ instance FromJSON AccountSettingsForm where parseJSON = A.genericParseJSON gDefa
|
|||
instance ToJSON AccountSettingsForm where toJSON = A.genericToJSON gDefaultFormOptions
|
||||
|
||||
toAccountSettingsForm :: User -> AccountSettingsForm
|
||||
toAccountSettingsForm (User {..}) =
|
||||
toAccountSettingsForm User {..} =
|
||||
AccountSettingsForm
|
||||
{ _privateDefault = userPrivateDefault
|
||||
, _archiveDefault = userArchiveDefault
|
||||
|
|
@ -618,12 +616,12 @@ toAccountSettingsForm (User {..}) =
|
|||
}
|
||||
|
||||
updateUserFromAccountSettingsForm :: Key User -> AccountSettingsForm -> DB ()
|
||||
updateUserFromAccountSettingsForm userId (AccountSettingsForm {..}) = do
|
||||
updateUserFromAccountSettingsForm userId AccountSettingsForm {..} =
|
||||
CP.update userId
|
||||
[ UserPrivateDefault CP.=. _privateDefault
|
||||
, UserArchiveDefault CP.=. _archiveDefault
|
||||
, UserPrivacyLock CP.=. _privacyLock
|
||||
]
|
||||
[ UserPrivateDefault CP.=. _privateDefault
|
||||
, UserArchiveDefault CP.=. _archiveDefault
|
||||
, UserPrivacyLock CP.=. _privacyLock
|
||||
]
|
||||
|
||||
-- BookmarkForm
|
||||
|
||||
|
|
@ -662,10 +660,10 @@ _toBookmarkForm' (Entity bid Bookmark {..}, tags) =
|
|||
, _description = Just $ Textarea $ bookmarkExtended
|
||||
, _tags = Just $ fromMaybe "" tags
|
||||
, _private = Just $ not bookmarkShared
|
||||
, _toread = Just $ bookmarkToRead
|
||||
, _toread = Just bookmarkToRead
|
||||
, _bid = Just $ unBookmarkKey $ bid
|
||||
, _slug = Just $ bookmarkSlug
|
||||
, _selected = Just $ bookmarkSelected
|
||||
, _slug = Just bookmarkSlug
|
||||
, _selected = Just bookmarkSelected
|
||||
, _time = Just $ UTCTimeStr $ bookmarkTime
|
||||
, _archiveUrl = bookmarkArchiveHref
|
||||
}
|
||||
|
|
@ -682,16 +680,16 @@ _toBookmark userId BookmarkForm {..} = do
|
|||
, bookmarkHref = _url
|
||||
, bookmarkDescription = fromMaybe "" _title
|
||||
, bookmarkExtended = maybe "" unTextarea _description
|
||||
, bookmarkTime = fromMaybe time (fmap unUTCTimeStr _time)
|
||||
, bookmarkTime = maybe time unUTCTimeStr _time
|
||||
, bookmarkShared = maybe True not _private
|
||||
, bookmarkToRead = fromMaybe False _toread
|
||||
, bookmarkSelected = fromMaybe False _selected
|
||||
, bookmarkToRead = Just True == _toread
|
||||
, bookmarkSelected = Just True == _selected
|
||||
, bookmarkArchiveHref = _archiveUrl
|
||||
}
|
||||
|
||||
fetchBookmarkByUrl :: Key User -> Maybe Text -> DB (Maybe (Entity Bookmark, [Entity BookmarkTag]))
|
||||
fetchBookmarkByUrl userId murl = runMaybeT do
|
||||
bmark <- MaybeT . getBy . UniqueUserHref userId =<< (MaybeT $ pure murl)
|
||||
bmark <- MaybeT . getBy . UniqueUserHref userId =<< MaybeT (pure murl)
|
||||
btags <- lift $ withTags (entityKey bmark)
|
||||
pure (bmark, btags)
|
||||
|
||||
|
|
@ -700,22 +698,22 @@ data UpsertResult = Created | Updated
|
|||
upsertBookmark :: Key User -> Maybe (Key Bookmark) -> Bookmark -> [Text] -> DB (UpsertResult, Key Bookmark)
|
||||
upsertBookmark userId mbid bm tags = do
|
||||
res <- case mbid of
|
||||
Just bid -> do
|
||||
Just bid ->
|
||||
get bid >>= \case
|
||||
Just prev_bm -> do
|
||||
when (userId /= bookmarkUserId prev_bm)
|
||||
(throwString "unauthorized")
|
||||
replaceBookmark bid prev_bm
|
||||
_ -> throwString "not found"
|
||||
Nothing -> do
|
||||
Just prev_bm -> do
|
||||
when (userId /= bookmarkUserId prev_bm)
|
||||
(throwString "unauthorized")
|
||||
replaceBookmark bid prev_bm
|
||||
_ -> throwString "not found"
|
||||
Nothing ->
|
||||
getBy (UniqueUserHref (bookmarkUserId bm) (bookmarkHref bm)) >>= \case
|
||||
Just (Entity bid prev_bm) -> replaceBookmark bid prev_bm
|
||||
_ -> (Created,) <$> insert bm
|
||||
Just (Entity bid prev_bm) -> replaceBookmark bid prev_bm
|
||||
_ -> (Created,) <$> insert bm
|
||||
insertTags (bookmarkUserId bm) (snd res)
|
||||
pure res
|
||||
where
|
||||
prepareReplace prev_bm = do
|
||||
if (bookmarkHref bm /= bookmarkHref prev_bm)
|
||||
prepareReplace prev_bm =
|
||||
if bookmarkHref bm /= bookmarkHref prev_bm
|
||||
then bm { bookmarkArchiveHref = Nothing }
|
||||
else bm { bookmarkArchiveHref = bookmarkArchiveHref prev_bm }
|
||||
replaceBookmark bid prev_bm = do
|
||||
|
|
@ -729,18 +727,18 @@ upsertBookmark userId mbid bm tags = do
|
|||
\(i, tag) -> void $ insert $ BookmarkTag userId' tag bid' i
|
||||
|
||||
updateBookmarkArchiveUrl :: Key User -> Key Bookmark -> Maybe Text -> DB ()
|
||||
updateBookmarkArchiveUrl userId bid marchiveUrl = do
|
||||
updateBookmarkArchiveUrl userId bid marchiveUrl =
|
||||
updateWhere
|
||||
[BookmarkUserId CP.==. userId, BookmarkId CP.==. bid]
|
||||
[BookmarkArchiveHref CP.=. marchiveUrl]
|
||||
[BookmarkUserId CP.==. userId, BookmarkId CP.==. bid]
|
||||
[BookmarkArchiveHref CP.=. marchiveUrl]
|
||||
|
||||
upsertNote :: Key User -> Maybe (Key Note) -> Note -> DB (UpsertResult, Key Note)
|
||||
upsertNote userId mnid note = do
|
||||
upsertNote userId mnid note =
|
||||
case mnid of
|
||||
Just nid -> do
|
||||
get nid >>= \case
|
||||
Just note' -> do
|
||||
when (userId /= (noteUserId note'))
|
||||
when (userId /= noteUserId note')
|
||||
(throwString "unauthorized")
|
||||
replace nid note
|
||||
pure (Updated, nid)
|
||||
|
|
@ -774,7 +772,7 @@ instance FromJSON FileBookmark where
|
|||
parseJSON _ = A.parseFail "bad parse"
|
||||
|
||||
instance ToJSON FileBookmark where
|
||||
toJSON (FileBookmark {..}) =
|
||||
toJSON FileBookmark {..} =
|
||||
object
|
||||
[ "href" .= toJSON fileBookmarkHref
|
||||
, "description" .= toJSON fileBookmarkDescription
|
||||
|
|
@ -815,7 +813,7 @@ instance FromJSON FileNote where
|
|||
parseJSON _ = A.parseFail "bad parse"
|
||||
|
||||
instance ToJSON FileNote where
|
||||
toJSON (FileNote {..}) =
|
||||
toJSON FileNote {..} =
|
||||
object
|
||||
[ "id" .= toJSON fileNoteId
|
||||
, "title" .= toJSON fileNoteTitle
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ instance PathPiece UserNameP where
|
|||
_ -> Nothing
|
||||
|
||||
instance PathPiece TagsP where
|
||||
toPathPiece (TagsP tags) = "t:" <> (intercalate "+" tags)
|
||||
toPathPiece (TagsP tags) = "t:" <> intercalate "+" tags
|
||||
fromPathPiece s =
|
||||
case splitOn ":" s of
|
||||
["t", ""] -> Nothing
|
||||
|
|
|
|||
Loading…
Reference in a new issue