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