diff --git a/src/Handler/Add.hs b/src/Handler/Add.hs index db5161a..a392966 100644 --- a/src/Handler/Add.hs +++ b/src/Handler/Add.hs @@ -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 diff --git a/src/Handler/Archive.hs b/src/Handler/Archive.hs index 3ee4c08..e7f7b22 100644 --- a/src/Handler/Archive.hs +++ b/src/Handler/Archive.hs @@ -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 "") 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 diff --git a/src/Handler/Common.hs b/src/Handler/Common.hs index f1a3f2d..fd7ccce 100644 --- a/src/Handler/Common.hs +++ b/src/Handler/Common.hs @@ -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 - + diff --git a/src/Handler/Docs.hs b/src/Handler/Docs.hs index 07d5ea0..bb596cf 100644 --- a/src/Handler/Docs.hs +++ b/src/Handler/Docs.hs @@ -5,5 +5,5 @@ module Handler.Docs where import Import getDocsSearchR :: Handler Html -getDocsSearchR = popupLayout $ +getDocsSearchR = popupLayout $(widgetFile "docs-search") diff --git a/src/Handler/Notes.hs b/src/Handler/Notes.hs index 32fe135..2ede799 100644 --- a/src/Handler/Notes.hs +++ b/src/Handler/Notes.hs @@ -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 diff --git a/src/Handler/User.hs b/src/Handler/User.hs index 4c6efcc..26646af 100644 --- a/src/Handler/User.hs +++ b/src/Handler/User.hs @@ -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 $ diff --git a/src/Import.hs b/src/Import.hs index a761bd2..49fcc1c 100644 --- a/src/Import.hs +++ b/src/Import.hs @@ -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)] diff --git a/src/Model.hs b/src/Model.hs index b4768c7..592b2a1 100644 --- a/src/Model.hs +++ b/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 diff --git a/src/PathPiece.hs b/src/PathPiece.hs index 68a6d14..7df9866 100644 --- a/src/PathPiece.hs +++ b/src/PathPiece.hs @@ -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