add ExportBookmarks
This commit is contained in:
parent
a617c695c8
commit
68b8c7ac88
|
@ -8,7 +8,6 @@ import ModelCustom
|
||||||
|
|
||||||
import qualified Database.Persist as P
|
import qualified Database.Persist as P
|
||||||
import qualified Database.Persist.Sqlite as P
|
import qualified Database.Persist.Sqlite as P
|
||||||
|
|
||||||
import ClassyPrelude
|
import ClassyPrelude
|
||||||
import Lens.Micro
|
import Lens.Micro
|
||||||
|
|
||||||
|
@ -25,6 +24,9 @@ data MigrationOpts
|
||||||
| ImportBookmarks { conn :: Text
|
| ImportBookmarks { conn :: Text
|
||||||
, userName :: Text
|
, userName :: Text
|
||||||
, bookmarkFile :: FilePath}
|
, bookmarkFile :: FilePath}
|
||||||
|
| ExportBookmarks { conn :: Text
|
||||||
|
, userName :: Text
|
||||||
|
, bookmarkFile :: FilePath}
|
||||||
| ImportNotes { conn :: Text
|
| ImportNotes { conn :: Text
|
||||||
, userName :: Text
|
, userName :: Text
|
||||||
, noteDirectory :: FilePath}
|
, noteDirectory :: FilePath}
|
||||||
|
@ -75,6 +77,13 @@ main = do
|
||||||
Just (P.Entity uid _) -> insertFileBookmarks uid file
|
Just (P.Entity uid _) -> insertFileBookmarks uid file
|
||||||
Nothing -> liftIO (print (uname ++ "not found"))
|
Nothing -> liftIO (print (uname ++ "not found"))
|
||||||
|
|
||||||
|
ExportBookmarks conn uname file ->
|
||||||
|
P.runSqlite conn $ do
|
||||||
|
muser <- P.getBy (UniqueUserName uname)
|
||||||
|
case muser of
|
||||||
|
Just (P.Entity uid _) -> exportFileBookmarks uid file
|
||||||
|
Nothing -> liftIO (print (uname ++ "not found"))
|
||||||
|
|
||||||
ImportNotes conn uname dir ->
|
ImportNotes conn uname dir ->
|
||||||
P.runSqlite conn $ do
|
P.runSqlite conn $ do
|
||||||
muser <- P.getBy (UniqueUserName uname)
|
muser <- P.getBy (UniqueUserName uname)
|
||||||
|
|
|
@ -193,11 +193,7 @@ bmark b' =
|
||||||
editField f = Just <<< BEditField <<< f
|
editField f = Just <<< BEditField <<< f
|
||||||
linkToFilterSingle slug = fromNullableStr app.userR <> "/b:" <> slug
|
linkToFilterSingle slug = fromNullableStr app.userR <> "/b:" <> slug
|
||||||
linkToFilterTag tag = fromNullableStr app.userR <> "/t:" <> tag
|
linkToFilterTag tag = fromNullableStr app.userR <> "/t:" <> tag
|
||||||
shtime = S.take 16 bm.time
|
shtime = S.take 16 bm.time `append` "Z"
|
||||||
toTextarea input =
|
|
||||||
S.split (Pattern "\n") input
|
|
||||||
# foldMap (\x -> [br_, text x])
|
|
||||||
# drop 1
|
|
||||||
|
|
||||||
handleAction :: BAction -> H.HalogenM BState BAction ChildSlots BMessage Aff Unit
|
handleAction :: BAction -> H.HalogenM BState BAction ChildSlots BMessage Aff Unit
|
||||||
|
|
||||||
|
|
136
src/Model.hs
136
src/Model.hs
|
@ -9,6 +9,7 @@ import qualified Control.Monad.Combinators as PC
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
import qualified Data.Time.ISO8601 as TI
|
import qualified Data.Time.ISO8601 as TI
|
||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto as E
|
||||||
|
import Database.Esqueleto.Internal.Sql as E
|
||||||
import qualified Data.Time as TI
|
import qualified Data.Time as TI
|
||||||
import ClassyPrelude.Yesod hiding ((||.))
|
import ClassyPrelude.Yesod hiding ((||.))
|
||||||
import Control.Monad.Trans.Maybe
|
import Control.Monad.Trans.Maybe
|
||||||
|
@ -21,6 +22,7 @@ import Database.Esqueleto hiding ((==.))
|
||||||
import Pretty
|
import Pretty
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Types
|
import Types
|
||||||
|
import qualified Data.Map.Strict as MS
|
||||||
|
|
||||||
import ModelCustom
|
import ModelCustom
|
||||||
|
|
||||||
|
@ -107,6 +109,7 @@ data FilterP
|
||||||
|
|
||||||
newtype UnreadOnly =
|
newtype UnreadOnly =
|
||||||
UnreadOnly { unUnreadOnly :: Bool }
|
UnreadOnly { unUnreadOnly :: Bool }
|
||||||
|
|
||||||
deriving (Eq, Show, Read)
|
deriving (Eq, Show, Read)
|
||||||
|
|
||||||
type Limit = Int64
|
type Limit = Int64
|
||||||
|
@ -132,6 +135,13 @@ migrateIndexes =
|
||||||
, "CREATE INDEX IF NOT EXISTS idx_note_user_created ON note (user_id, created DESC)"
|
, "CREATE INDEX IF NOT EXISTS idx_note_user_created ON note (user_id, created DESC)"
|
||||||
]
|
]
|
||||||
|
|
||||||
|
sqlite_group_concat ::
|
||||||
|
PersistField a
|
||||||
|
=> SqlExpr (E.Value a)
|
||||||
|
-> SqlExpr (E.Value a)
|
||||||
|
-> SqlExpr (E.Value Text)
|
||||||
|
sqlite_group_concat expr sep = E.unsafeSqlFunction "GROUP_CONCAT" [expr, sep]
|
||||||
|
|
||||||
authenticatePassword :: Text -> Text -> DB (Maybe (Entity User))
|
authenticatePassword :: Text -> Text -> DB (Maybe (Entity User))
|
||||||
authenticatePassword username password = do
|
authenticatePassword username password = do
|
||||||
muser <- getBy (UniqueUserName username)
|
muser <- getBy (UniqueUserName username)
|
||||||
|
@ -298,12 +308,9 @@ getNoteList key mquery limit' page =
|
||||||
|
|
||||||
-- Bookmark Files
|
-- Bookmark Files
|
||||||
|
|
||||||
bookmarkEntityToTags :: Entity Bookmark -> [Tag] -> [BookmarkTag]
|
mkBookmarkTags :: Key User -> Key Bookmark -> [Tag] -> [BookmarkTag]
|
||||||
bookmarkEntityToTags (Entity {entityKey = bookmarkId
|
mkBookmarkTags userId bookmarkId tags =
|
||||||
,entityVal = Bookmark {..}}) tags =
|
(\(i, tag) -> BookmarkTag userId tag bookmarkId i) <$> zip [1 ..] tags
|
||||||
fmap
|
|
||||||
(\(i, tag) -> BookmarkTag bookmarkUserId tag bookmarkId i)
|
|
||||||
(zip [1 ..] tags)
|
|
||||||
|
|
||||||
|
|
||||||
fileBookmarkToBookmark :: UserId -> FileBookmark -> IO Bookmark
|
fileBookmarkToBookmark :: UserId -> FileBookmark -> IO Bookmark
|
||||||
|
@ -319,8 +326,21 @@ fileBookmarkToBookmark user (FileBookmark {..}) = do
|
||||||
fileBookmarkTime
|
fileBookmarkTime
|
||||||
fileBookmarkShared
|
fileBookmarkShared
|
||||||
fileBookmarkToRead
|
fileBookmarkToRead
|
||||||
False
|
(fromMaybe False fileBookmarkSelected)
|
||||||
Nothing
|
fileBookmarkArchiveHref
|
||||||
|
|
||||||
|
bookmarkTofileBookmark :: Bookmark -> Text -> FileBookmark
|
||||||
|
bookmarkTofileBookmark (Bookmark {..}) tags =
|
||||||
|
FileBookmark
|
||||||
|
bookmarkHref
|
||||||
|
bookmarkDescription
|
||||||
|
bookmarkExtended
|
||||||
|
bookmarkTime
|
||||||
|
bookmarkShared
|
||||||
|
bookmarkToRead
|
||||||
|
(Just bookmarkSelected)
|
||||||
|
bookmarkArchiveHref
|
||||||
|
tags
|
||||||
|
|
||||||
|
|
||||||
insertFileBookmarks :: Key User -> FilePath -> DB ()
|
insertFileBookmarks :: Key User -> FilePath -> DB ()
|
||||||
|
@ -329,20 +349,56 @@ insertFileBookmarks userId bookmarkFile = do
|
||||||
case mfmarks of
|
case mfmarks of
|
||||||
Left e -> print e
|
Left e -> print e
|
||||||
Right fmarks -> do
|
Right fmarks -> do
|
||||||
bookmarks <- liftIO $ mapM (fileBookmarkToBookmark userId) fmarks
|
bmarks <- liftIO $ mapM (fileBookmarkToBookmark userId) fmarks
|
||||||
mbookmarkIds <- mapM insertUnique bookmarks
|
mbids <- mapM insertUnique bmarks
|
||||||
|
void $
|
||||||
let bookmarkTags =
|
mapM insertUnique $
|
||||||
concatMap (uncurry bookmarkEntityToTags) $
|
concatMap (uncurry (mkBookmarkTags userId)) $
|
||||||
catMaybes $
|
catMaybes $
|
||||||
zipWith3 (\mk v p -> map (\k -> (Entity k v, fileBookmarkTags p)) mk)
|
zipWith
|
||||||
mbookmarkIds
|
(\mbid tags -> ((, tags) <$> mbid))
|
||||||
bookmarks
|
mbids
|
||||||
fmarks
|
(extractTags <$> fmarks)
|
||||||
void $ mapM insertUnique bookmarkTags
|
|
||||||
where
|
where
|
||||||
readFileBookmarks :: MonadIO m => FilePath -> m (Either String [FileBookmark])
|
extractTags = words . fileBookmarkTags
|
||||||
readFileBookmarks fpath = pure . A.eitherDecode' . fromStrict =<< readFile fpath
|
|
||||||
|
readFileBookmarks :: MonadIO m => FilePath -> m (Either String [FileBookmark])
|
||||||
|
readFileBookmarks fpath =
|
||||||
|
pure . A.eitherDecode' . fromStrict =<< readFile fpath
|
||||||
|
|
||||||
|
exportFileBookmarks :: Key User -> FilePath -> DB ()
|
||||||
|
exportFileBookmarks user fpath = do
|
||||||
|
liftIO . A.encodeFile fpath =<< getFileBookmarks user
|
||||||
|
|
||||||
|
getFileBookmarks :: Key User -> DB [FileBookmark]
|
||||||
|
getFileBookmarks user = do
|
||||||
|
marks <- allUserBookmarks user
|
||||||
|
pure $ fmap (\(bm, t) -> bookmarkTofileBookmark (entityVal bm) t) marks
|
||||||
|
|
||||||
|
-- returns a list of pair of bookmark with tags merged into a string
|
||||||
|
allUserBookmarks :: Key User -> DB [(Entity Bookmark, Text)]
|
||||||
|
allUserBookmarks user = do
|
||||||
|
bmarks <- bquery
|
||||||
|
tags <- tquery
|
||||||
|
let tagmap = MS.fromList tags
|
||||||
|
pure $ fmap (\bm@(Entity bid _) -> (bm, findWithDefault mempty bid tagmap)) bmarks
|
||||||
|
where
|
||||||
|
bquery :: DB [Entity Bookmark]
|
||||||
|
bquery =
|
||||||
|
select $
|
||||||
|
from $ \b -> do
|
||||||
|
where_ (b ^. BookmarkUserId E.==. val user)
|
||||||
|
orderBy [asc (b ^. BookmarkTime)]
|
||||||
|
pure b
|
||||||
|
tquery :: DB [(Key Bookmark, Text)]
|
||||||
|
tquery =
|
||||||
|
fmap (\(tid, tags) -> (E.unValue tid, E.unValue tags)) <$>
|
||||||
|
(select $
|
||||||
|
from $ \t -> do
|
||||||
|
where_ (t ^. BookmarkTagUserId E.==. val user)
|
||||||
|
E.groupBy (t ^. BookmarkTagBookmarkId)
|
||||||
|
let tags = sqlite_group_concat (t ^. BookmarkTagTag) (E.val " ")
|
||||||
|
pure (t ^. BookmarkTagBookmarkId, tags))
|
||||||
|
|
||||||
type Tag = Text
|
type Tag = Text
|
||||||
|
|
||||||
|
@ -528,7 +584,9 @@ data FileBookmark = FileBookmark
|
||||||
, fileBookmarkTime :: !UTCTime
|
, fileBookmarkTime :: !UTCTime
|
||||||
, fileBookmarkShared :: !Bool
|
, fileBookmarkShared :: !Bool
|
||||||
, fileBookmarkToRead :: !Bool
|
, fileBookmarkToRead :: !Bool
|
||||||
, fileBookmarkTags :: [Tag]
|
, fileBookmarkSelected :: !(Maybe Bool)
|
||||||
|
, fileBookmarkArchiveHref :: !(Maybe Text)
|
||||||
|
, fileBookmarkTags :: !Text
|
||||||
} deriving (Show, Eq, Typeable, Ord)
|
} deriving (Show, Eq, Typeable, Ord)
|
||||||
|
|
||||||
instance FromJSON FileBookmark where
|
instance FromJSON FileBookmark where
|
||||||
|
@ -537,13 +595,33 @@ instance FromJSON FileBookmark where
|
||||||
o .: "time" <*>
|
o .: "time" <*>
|
||||||
(boolFromYesNo <$> o .: "shared") <*>
|
(boolFromYesNo <$> o .: "shared") <*>
|
||||||
(boolFromYesNo <$> o .: "toread") <*>
|
(boolFromYesNo <$> o .: "toread") <*>
|
||||||
(words <$> o .: "tags")
|
(o A..:? "selected") <*>
|
||||||
|
(o A..:? "archive_url") <*>
|
||||||
|
(o .: "tags")
|
||||||
parseJSON _ = fail "bad parse"
|
parseJSON _ = fail "bad parse"
|
||||||
|
|
||||||
|
instance ToJSON FileBookmark where
|
||||||
|
toJSON (FileBookmark {..}) =
|
||||||
|
object
|
||||||
|
[ "href" .= toJSON fileBookmarkHref
|
||||||
|
, "description" .= toJSON fileBookmarkDescription
|
||||||
|
, "extended" .= toJSON fileBookmarkExtended
|
||||||
|
, "time" .= toJSON fileBookmarkTime
|
||||||
|
, "shared" .= toJSON (boolToYesNo fileBookmarkShared)
|
||||||
|
, "toread" .= toJSON (boolToYesNo fileBookmarkToRead)
|
||||||
|
, "selected" .= toJSON fileBookmarkSelected
|
||||||
|
, "archive_url" .= toJSON fileBookmarkArchiveHref
|
||||||
|
, "tags" .= toJSON fileBookmarkTags
|
||||||
|
]
|
||||||
|
|
||||||
boolFromYesNo :: Text -> Bool
|
boolFromYesNo :: Text -> Bool
|
||||||
boolFromYesNo "yes" = True
|
boolFromYesNo "yes" = True
|
||||||
boolFromYesNo _ = False
|
boolFromYesNo _ = False
|
||||||
|
|
||||||
|
boolToYesNo :: Bool -> Text
|
||||||
|
boolToYesNo True = "yes"
|
||||||
|
boolToYesNo _ = "no"
|
||||||
|
|
||||||
-- * FileNotes
|
-- * FileNotes
|
||||||
|
|
||||||
data FileNote = FileNote
|
data FileNote = FileNote
|
||||||
|
@ -563,7 +641,21 @@ instance FromJSON FileNote where
|
||||||
(readFileNoteTime =<< o .: "updated_at")
|
(readFileNoteTime =<< o .: "updated_at")
|
||||||
parseJSON _ = fail "bad parse"
|
parseJSON _ = fail "bad parse"
|
||||||
|
|
||||||
|
instance ToJSON FileNote where
|
||||||
|
toJSON (FileNote {..}) =
|
||||||
|
object
|
||||||
|
[ "id" .= toJSON fileNoteId
|
||||||
|
, "title" .= toJSON fileNoteTitle
|
||||||
|
, "text" .= toJSON fileNoteText
|
||||||
|
, "length" .= toJSON fileNoteLength
|
||||||
|
, "created_at" .= toJSON (showFileNoteTime fileNoteCreatedAt)
|
||||||
|
, "updated_at" .= toJSON (showFileNoteTime fileNoteUpdatedAt)
|
||||||
|
]
|
||||||
|
|
||||||
readFileNoteTime
|
readFileNoteTime
|
||||||
:: Monad m
|
:: Monad m
|
||||||
=> String -> m UTCTime
|
=> String -> m UTCTime
|
||||||
readFileNoteTime = parseTimeM True defaultTimeLocale "%F %T"
|
readFileNoteTime = parseTimeM True defaultTimeLocale "%F %T"
|
||||||
|
|
||||||
|
showFileNoteTime :: UTCTime -> String
|
||||||
|
showFileNoteTime = formatTime defaultTimeLocale "%F %T"
|
||||||
|
|
2
static/js/app.min.js
vendored
2
static/js/app.min.js
vendored
File diff suppressed because one or more lines are too long
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
Loading…
Reference in a new issue