{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}

module Model where

import qualified ClassyPrelude.Yesod as CP
import qualified Control.Monad.Combinators as PC (between)
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.Types as A (parseFail)
import qualified Data.Attoparsec.Text as P
import qualified Data.Time as TI (ParseTime)
import qualified Data.Time.Clock.POSIX as TI (posixSecondsToUTCTime, POSIXTime)
import qualified Data.Time.ISO8601 as TI (parseISO8601, formatISO8601Millis)
import ClassyPrelude.Yesod hiding ((==.), (||.), on, Value, groupBy, exists, (>=.), (<=.))
import Control.Monad.Fail (MonadFail)
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import Control.Monad.Writer (tell)
import Data.Char (isSpace)
import Data.Either (fromRight)
import Data.Foldable (foldl, foldl1, sequenceA_)
import Data.List.NonEmpty (NonEmpty(..))
import Database.Esqueleto.Experimental
import Database.Esqueleto.Internal.Internal (unsafeSqlFunction)
import Pretty ()
import System.Directory (listDirectory)
import Types

import qualified Data.Map.Strict as MS

import ModelCustom

share [mkPersist sqlSettings, mkMigrate "migrateSchema"] [persistLowerCase|
User json
  Id Int64
  name Text
  passwordHash BCrypt
  apiToken HashedApiKey Maybe
  privateDefault Bool
  archiveDefault Bool
  privacyLock Bool
  UniqueUserName name
  deriving Show Eq Typeable Ord

Bookmark json
  Id Int64
  userId UserId OnDeleteCascade
  slug BmSlug default="(lower(hex(randomblob(6))))"
  href Text
  description Text
  extended Text
  time UTCTime
  shared Bool
  toRead Bool
  selected Bool
  archiveHref Text Maybe
  UniqueUserHref userId href
  UniqueUserSlug userId slug
  deriving Show Eq Typeable Ord

BookmarkTag json
  Id Int64
  userId UserId OnDeleteCascade
  tag Text
  bookmarkId BookmarkId OnDeleteCascade
  seq Int
  UniqueUserTagBookmarkId userId tag bookmarkId
  UniqueUserBookmarkIdTagSeq userId bookmarkId tag seq
  deriving Show Eq Typeable Ord

Note json
  Id Int64
  userId UserId  OnDeleteCascade
  slug NtSlug default="(lower(hex(randomblob(10))))"
  length Int
  title Text
  text Text
  isMarkdown Bool
  shared Bool default=False
  created UTCTime
  updated UTCTime
  deriving Show Eq Typeable Ord
|]

newtype UTCTimeStr =
  UTCTimeStr { UTCTimeStr -> UTCTime
unUTCTimeStr :: UTCTime }
  deriving (UTCTimeStr -> UTCTimeStr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTCTimeStr -> UTCTimeStr -> Bool
$c/= :: UTCTimeStr -> UTCTimeStr -> Bool
== :: UTCTimeStr -> UTCTimeStr -> Bool
$c== :: UTCTimeStr -> UTCTimeStr -> Bool
Eq, Int -> UTCTimeStr -> ShowS
[UTCTimeStr] -> ShowS
UTCTimeStr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTCTimeStr] -> ShowS
$cshowList :: [UTCTimeStr] -> ShowS
show :: UTCTimeStr -> String
$cshow :: UTCTimeStr -> String
showsPrec :: Int -> UTCTimeStr -> ShowS
$cshowsPrec :: Int -> UTCTimeStr -> ShowS
Show, ReadPrec [UTCTimeStr]
ReadPrec UTCTimeStr
Int -> ReadS UTCTimeStr
ReadS [UTCTimeStr]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UTCTimeStr]
$creadListPrec :: ReadPrec [UTCTimeStr]
readPrec :: ReadPrec UTCTimeStr
$creadPrec :: ReadPrec UTCTimeStr
readList :: ReadS [UTCTimeStr]
$creadList :: ReadS [UTCTimeStr]
readsPrec :: Int -> ReadS UTCTimeStr
$creadsPrec :: Int -> ReadS UTCTimeStr
Read, forall x. Rep UTCTimeStr x -> UTCTimeStr
forall x. UTCTimeStr -> Rep UTCTimeStr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UTCTimeStr x -> UTCTimeStr
$cfrom :: forall x. UTCTimeStr -> Rep UTCTimeStr x
Generic, Value -> Parser [UTCTimeStr]
Value -> Parser UTCTimeStr
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UTCTimeStr]
$cparseJSONList :: Value -> Parser [UTCTimeStr]
parseJSON :: Value -> Parser UTCTimeStr
$cparseJSON :: Value -> Parser UTCTimeStr
FromJSON, [UTCTimeStr] -> Encoding
[UTCTimeStr] -> Value
UTCTimeStr -> Encoding
UTCTimeStr -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UTCTimeStr] -> Encoding
$ctoEncodingList :: [UTCTimeStr] -> Encoding
toJSONList :: [UTCTimeStr] -> Value
$ctoJSONList :: [UTCTimeStr] -> Value
toEncoding :: UTCTimeStr -> Encoding
$ctoEncoding :: UTCTimeStr -> Encoding
toJSON :: UTCTimeStr -> Value
$ctoJSON :: UTCTimeStr -> Value
ToJSON)

instance PathPiece UTCTimeStr where
  toPathPiece :: UTCTimeStr -> Text
toPathPiece (UTCTimeStr UTCTime
u) = forall seq. IsSequence seq => [Element seq] -> seq
pack (UTCTime -> String
TI.formatISO8601Millis UTCTime
u)
  fromPathPiece :: Text -> Maybe UTCTimeStr
fromPathPiece Text
s = UTCTime -> UTCTimeStr
UTCTimeStr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe UTCTime
TI.parseISO8601 (forall mono. MonoFoldable mono => mono -> [Element mono]
unpack Text
s)

newtype UserNameP =
  UserNameP { UserNameP -> Text
unUserNameP :: Text }
  deriving (UserNameP -> UserNameP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserNameP -> UserNameP -> Bool
$c/= :: UserNameP -> UserNameP -> Bool
== :: UserNameP -> UserNameP -> Bool
$c== :: UserNameP -> UserNameP -> Bool
Eq, Int -> UserNameP -> ShowS
[UserNameP] -> ShowS
UserNameP -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserNameP] -> ShowS
$cshowList :: [UserNameP] -> ShowS
show :: UserNameP -> String
$cshow :: UserNameP -> String
showsPrec :: Int -> UserNameP -> ShowS
$cshowsPrec :: Int -> UserNameP -> ShowS
Show, ReadPrec [UserNameP]
ReadPrec UserNameP
Int -> ReadS UserNameP
ReadS [UserNameP]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserNameP]
$creadListPrec :: ReadPrec [UserNameP]
readPrec :: ReadPrec UserNameP
$creadPrec :: ReadPrec UserNameP
readList :: ReadS [UserNameP]
$creadList :: ReadS [UserNameP]
readsPrec :: Int -> ReadS UserNameP
$creadsPrec :: Int -> ReadS UserNameP
Read)

newtype TagsP =
  TagsP { TagsP -> [Text]
unTagsP :: [Text] }
  deriving (TagsP -> TagsP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagsP -> TagsP -> Bool
$c/= :: TagsP -> TagsP -> Bool
== :: TagsP -> TagsP -> Bool
$c== :: TagsP -> TagsP -> Bool
Eq, Int -> TagsP -> ShowS
[TagsP] -> ShowS
TagsP -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagsP] -> ShowS
$cshowList :: [TagsP] -> ShowS
show :: TagsP -> String
$cshow :: TagsP -> String
showsPrec :: Int -> TagsP -> ShowS
$cshowsPrec :: Int -> TagsP -> ShowS
Show, ReadPrec [TagsP]
ReadPrec TagsP
Int -> ReadS TagsP
ReadS [TagsP]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagsP]
$creadListPrec :: ReadPrec [TagsP]
readPrec :: ReadPrec TagsP
$creadPrec :: ReadPrec TagsP
readList :: ReadS [TagsP]
$creadList :: ReadS [TagsP]
readsPrec :: Int -> ReadS TagsP
$creadsPrec :: Int -> ReadS TagsP
Read)

data SharedP
  = SharedAll
  | SharedPublic
  | SharedPrivate
  deriving (SharedP -> SharedP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SharedP -> SharedP -> Bool
$c/= :: SharedP -> SharedP -> Bool
== :: SharedP -> SharedP -> Bool
$c== :: SharedP -> SharedP -> Bool
Eq, Int -> SharedP -> ShowS
[SharedP] -> ShowS
SharedP -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SharedP] -> ShowS
$cshowList :: [SharedP] -> ShowS
show :: SharedP -> String
$cshow :: SharedP -> String
showsPrec :: Int -> SharedP -> ShowS
$cshowsPrec :: Int -> SharedP -> ShowS
Show, ReadPrec [SharedP]
ReadPrec SharedP
Int -> ReadS SharedP
ReadS [SharedP]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SharedP]
$creadListPrec :: ReadPrec [SharedP]
readPrec :: ReadPrec SharedP
$creadPrec :: ReadPrec SharedP
readList :: ReadS [SharedP]
$creadList :: ReadS [SharedP]
readsPrec :: Int -> ReadS SharedP
$creadsPrec :: Int -> ReadS SharedP
Read)

data FilterP
  = FilterAll
  | FilterUnread
  | FilterUntagged
  | FilterStarred
  | FilterSingle BmSlug
  deriving (FilterP -> FilterP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterP -> FilterP -> Bool
$c/= :: FilterP -> FilterP -> Bool
== :: FilterP -> FilterP -> Bool
$c== :: FilterP -> FilterP -> Bool
Eq, Int -> FilterP -> ShowS
[FilterP] -> ShowS
FilterP -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterP] -> ShowS
$cshowList :: [FilterP] -> ShowS
show :: FilterP -> String
$cshow :: FilterP -> String
showsPrec :: Int -> FilterP -> ShowS
$cshowsPrec :: Int -> FilterP -> ShowS
Show, ReadPrec [FilterP]
ReadPrec FilterP
Int -> ReadS FilterP
ReadS [FilterP]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FilterP]
$creadListPrec :: ReadPrec [FilterP]
readPrec :: ReadPrec FilterP
$creadPrec :: ReadPrec FilterP
readList :: ReadS [FilterP]
$creadList :: ReadS [FilterP]
readsPrec :: Int -> ReadS FilterP
$creadsPrec :: Int -> ReadS FilterP
Read)

newtype UnreadOnly =
  UnreadOnly { UnreadOnly -> Bool
unUnreadOnly :: Bool }

  deriving (UnreadOnly -> UnreadOnly -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnreadOnly -> UnreadOnly -> Bool
$c/= :: UnreadOnly -> UnreadOnly -> Bool
== :: UnreadOnly -> UnreadOnly -> Bool
$c== :: UnreadOnly -> UnreadOnly -> Bool
Eq, Int -> UnreadOnly -> ShowS
[UnreadOnly] -> ShowS
UnreadOnly -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnreadOnly] -> ShowS
$cshowList :: [UnreadOnly] -> ShowS
show :: UnreadOnly -> String
$cshow :: UnreadOnly -> String
showsPrec :: Int -> UnreadOnly -> ShowS
$cshowsPrec :: Int -> UnreadOnly -> ShowS
Show, ReadPrec [UnreadOnly]
ReadPrec UnreadOnly
Int -> ReadS UnreadOnly
ReadS [UnreadOnly]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnreadOnly]
$creadListPrec :: ReadPrec [UnreadOnly]
readPrec :: ReadPrec UnreadOnly
$creadPrec :: ReadPrec UnreadOnly
readList :: ReadS [UnreadOnly]
$creadList :: ReadS [UnreadOnly]
readsPrec :: Int -> ReadS UnreadOnly
$creadsPrec :: Int -> ReadS UnreadOnly
Read)

type Limit = Int64
type Page = Int64

migrateAll :: Migration
migrateAll :: Migration
migrateAll = Migration
migrateSchema forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Migration
migrateIndexes

dumpMigration :: DB ()
dumpMigration :: DB ()
dumpMigration = forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m ()
printMigration Migration
migrateAll

runMigrations :: DB ()
runMigrations :: DB ()
runMigrations = forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
runMigration Migration
migrateAll

toMigration :: [Text] -> Migration
toMigration :: [Text] -> Migration
toMigration = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
False ,)

migrateIndexes :: Migration
migrateIndexes :: Migration
migrateIndexes =
  [Text] -> Migration
toMigration
    [ Text
"CREATE INDEX IF NOT EXISTS idx_bookmark_time ON bookmark (user_id, time DESC)"
    , Text
"CREATE INDEX IF NOT EXISTS idx_bookmark_tag_bookmark_id ON bookmark_tag (bookmark_id, id, tag, seq)"
    , Text
"CREATE INDEX IF NOT EXISTS idx_note_user_created ON note (user_id, created DESC)"
    ]

sqliteGroupConcat ::
     PersistField a
  => SqlExpr (Value a)
  -> SqlExpr (Value a)
  -> SqlExpr (Value Text)
sqliteGroupConcat :: forall a.
PersistField a =>
SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Text)
sqliteGroupConcat SqlExpr (Value a)
expr SqlExpr (Value a)
sep = forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"GROUP_CONCAT" [SqlExpr (Value a)
expr, SqlExpr (Value a)
sep]

authenticatePassword :: Text -> Text -> DB (Maybe (Entity User))
authenticatePassword :: Text -> Text -> DB (Maybe (Entity User))
authenticatePassword Text
username Text
password = do
  forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy (Text -> Unique User
UniqueUserName Text
username) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Entity User)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Just Entity User
dbuser ->
      if BCrypt -> Text -> Bool
validatePasswordHash (User -> BCrypt
userPasswordHash (forall record. Entity record -> record
entityVal Entity User
dbuser)) Text
password
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Entity User
dbuser)
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

getUserByName :: UserNameP -> DB (Maybe (Entity User))
getUserByName :: UserNameP -> DB (Maybe (Entity User))
getUserByName (UserNameP Text
uname) =
  forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst [forall typ. (typ ~ Text) => EntityField User typ
UserName forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. Text
uname] []

getApiKeyUser :: ApiKey -> DB (Maybe (Entity User))
getApiKeyUser :: ApiKey -> DB (Maybe (Entity User))
getApiKeyUser ApiKey
apiKey =
  forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst [forall typ. (typ ~ Maybe HashedApiKey) => EntityField User typ
UserApiToken forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. forall a. a -> Maybe a
Just (ApiKey -> HashedApiKey
hashApiKey ApiKey
apiKey)] []

-- returns a list of pair of bookmark with tags merged into a string
bookmarksTagsQuery
  :: Key User
  -> SharedP
  -> FilterP
  -> [Tag]
  -> Maybe Text
  -> Limit
  -> Page
  -> DB (Int, [(Entity Bookmark, Maybe Text)])
bookmarksTagsQuery :: Key User
-> SharedP
-> FilterP
-> [Text]
-> Maybe Text
-> Int64
-> Int64
-> DB (Int, [(Entity Bookmark, Maybe Text)])
bookmarksTagsQuery Key User
userId SharedP
sharedp FilterP
filterp [Text]
tags Maybe Text
mquery Int64
limit' Int64
page =
  (,) -- total count
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall mono.
(MonoFoldable mono, Num (Element mono)) =>
mono -> Element mono
sum forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Value a -> a
unValue)
      (forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select forall a b. (a -> b) -> a -> b
$ forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @Bookmark) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SqlExpr (Entity Bookmark)
b -> do
       SqlExpr (Entity Bookmark) -> SqlQuery ()
_whereClause SqlExpr (Entity Bookmark)
b
       forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Num a => SqlExpr (Value a)
countRows)
      -- paged data
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall a. Value a -> a
unValue
      (forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select forall a b. (a -> b) -> a -> b
$ forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @Bookmark) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SqlExpr (Entity Bookmark)
b -> do
       SqlExpr (Entity Bookmark) -> SqlQuery ()
_whereClause SqlExpr (Entity Bookmark)
b
       [SqlExpr OrderBy] -> SqlQuery ()
orderBy [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
desc (SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ UTCTime) => EntityField Bookmark typ
BookmarkTime)]
       Int64 -> SqlQuery ()
limit Int64
limit'
       Int64 -> SqlQuery ()
offset ((Int64
page forall a. Num a => a -> a -> a
- Int64
1) forall a. Num a => a -> a -> a
* Int64
limit')
       forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity Bookmark)
b, forall a.
PersistField a =>
SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value (Maybe a))
subSelect forall a b. (a -> b) -> a -> b
$ forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SqlExpr (Entity BookmarkTag)
t -> do
                SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId)
                forall a. ToSomeValues a => a -> SqlQuery ()
groupBy (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId)
                [SqlExpr OrderBy] -> SqlQuery ()
orderBy [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
asc (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Int) => EntityField BookmarkTag typ
BookmarkTagSeq)]
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
PersistField a =>
SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Text)
sqliteGroupConcat (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag) (forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Text
" ")))
  where
    _whereClause :: SqlExpr (Entity Bookmark) -> SqlQuery ()
_whereClause SqlExpr (Entity Bookmark)
b = do
      SqlExpr (Value Bool) -> SqlQuery ()
where_ forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\SqlExpr (Value Bool)
expr Text
tag ->
                SqlExpr (Value Bool)
expr SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&. SqlQuery () -> SqlExpr (Value Bool)
exists (   -- each tag becomes an exists constraint
                          forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SqlExpr (Entity BookmarkTag)
t ->
                          SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&.
                                 (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
`like` forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Text
tag))))
          (SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key User) => EntityField Bookmark typ
BookmarkUserId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key User
userId)
          [Text]
tags
      case SharedP
sharedp of
        SharedP
SharedAll -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        SharedP
SharedPublic ->  SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Bool) => EntityField Bookmark typ
BookmarkShared forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Bool
True)
        SharedP
SharedPrivate -> SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Bool) => EntityField Bookmark typ
BookmarkShared forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Bool
False)
      case FilterP
filterp of
        FilterP
FilterAll -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        FilterP
FilterUnread -> SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Bool) => EntityField Bookmark typ
BookmarkToRead forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Bool
True)
        FilterP
FilterStarred -> SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Bool) => EntityField Bookmark typ
BookmarkSelected forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Bool
True)
        FilterSingle BmSlug
slug -> SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ BmSlug) => EntityField Bookmark typ
BookmarkSlug forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val BmSlug
slug)
        FilterP
FilterUntagged -> SqlExpr (Value Bool) -> SqlQuery ()
where_ forall a b. (a -> b) -> a -> b
$ SqlQuery () -> SqlExpr (Value Bool)
notExists forall a b. (a -> b) -> a -> b
$ forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SqlExpr (Entity BookmarkTag)
t -> SqlExpr (Value Bool) -> SqlQuery ()
where_ forall a b. (a -> b) -> a -> b
$
                                                    SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId
      -- search
      forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ ((Text -> SqlExpr (Value Bool)) -> Text -> Maybe (SqlQuery ())
parseSearchQuery (SqlExpr (Entity Bookmark) -> Text -> SqlExpr (Value Bool)
toLikeExpr SqlExpr (Entity Bookmark)
b) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
mquery)

    toLikeExpr :: SqlExpr (Entity Bookmark) -> Text -> SqlExpr (Value Bool)
    toLikeExpr :: SqlExpr (Entity Bookmark) -> Text -> SqlExpr (Value Bool)
toLikeExpr SqlExpr (Entity Bookmark)
b Text
term = forall b a. b -> Either a b -> b
fromRight SqlExpr (Value Bool)
p_allFields (forall a. Parser a -> Text -> Either String a
P.parseOnly Parser Text (SqlExpr (Value Bool))
p_onefield Text
term)
      where
        wild :: s -> SqlExpr (Value s)
wild s
s = forall s. SqlString s => SqlExpr (Value s)
(%) forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
++. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val s
s forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
++. forall s. SqlString s => SqlExpr (Value s)
(%)
        toLikeB :: EntityField Bookmark Text -> Text -> SqlExpr (Value Bool)
toLikeB EntityField Bookmark Text
field Text
s = SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark Text
field forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
`like` forall {s}. SqlString s => s -> SqlExpr (Value s)
wild Text
s
        p_allFields :: SqlExpr (Value Bool)
p_allFields =
          EntityField Bookmark Text -> Text -> SqlExpr (Value Bool)
toLikeB forall typ. (typ ~ Text) => EntityField Bookmark typ
BookmarkHref Text
term SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
||.
          EntityField Bookmark Text -> Text -> SqlExpr (Value Bool)
toLikeB forall typ. (typ ~ Text) => EntityField Bookmark typ
BookmarkDescription Text
term SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
||.
          EntityField Bookmark Text -> Text -> SqlExpr (Value Bool)
toLikeB forall typ. (typ ~ Text) => EntityField Bookmark typ
BookmarkExtended Text
term SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
||.
          SqlQuery () -> SqlExpr (Value Bool)
exists (forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SqlExpr (Entity BookmarkTag)
t -> SqlExpr (Value Bool) -> SqlQuery ()
where_ forall a b. (a -> b) -> a -> b
$
               (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId) SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&.
               (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
`like` forall {s}. SqlString s => s -> SqlExpr (Value s)
wild Text
term))
        p_onefield :: Parser Text (SqlExpr (Value Bool))
p_onefield = Parser Text (SqlExpr (Value Bool))
p_url forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (SqlExpr (Value Bool))
p_title forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (SqlExpr (Value Bool))
p_description forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (SqlExpr (Value Bool))
p_tags forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (SqlExpr (Value Bool))
p_after forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (SqlExpr (Value Bool))
p_before
          where
            p_url :: Parser Text (SqlExpr (Value Bool))
p_url = Parser Text Text
"url:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EntityField Bookmark Text -> Text -> SqlExpr (Value Bool)
toLikeB forall typ. (typ ~ Text) => EntityField Bookmark typ
BookmarkHref) Parser Text Text
P.takeText
            p_title :: Parser Text (SqlExpr (Value Bool))
p_title = Parser Text Text
"title:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EntityField Bookmark Text -> Text -> SqlExpr (Value Bool)
toLikeB forall typ. (typ ~ Text) => EntityField Bookmark typ
BookmarkDescription) Parser Text Text
P.takeText
            p_description :: Parser Text (SqlExpr (Value Bool))
p_description = Parser Text Text
"description:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EntityField Bookmark Text -> Text -> SqlExpr (Value Bool)
toLikeB forall typ. (typ ~ Text) => EntityField Bookmark typ
BookmarkExtended) Parser Text Text
P.takeText
            p_tags :: Parser Text (SqlExpr (Value Bool))
p_tags = Parser Text Text
"tags:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
term' -> SqlQuery () -> SqlExpr (Value Bool)
exists forall a b. (a -> b) -> a -> b
$ forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SqlExpr (Entity BookmarkTag)
t -> SqlExpr (Value Bool) -> SqlQuery ()
where_ forall a b. (a -> b) -> a -> b
$
                                                         (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId) SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&.
                                                         (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
`like` forall {s}. SqlString s => s -> SqlExpr (Value s)
wild Text
term')) Parser Text Text
P.takeText
            p_after :: Parser Text (SqlExpr (Value Bool))
p_after  = Parser Text Text
"after:"  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ UTCTime) => EntityField Bookmark typ
BookmarkTime forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
>=.) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val) (forall t (m :: * -> *).
(ParseTime t, MonadFail m, Alternative m) =>
Text -> m t
parseTimeText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Text Text
P.takeText)
            p_before :: Parser Text (SqlExpr (Value Bool))
p_before = Parser Text Text
"before:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ UTCTime) => EntityField Bookmark typ
BookmarkTime forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
<=.) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val) (forall t (m :: * -> *).
(ParseTime t, MonadFail m, Alternative m) =>
Text -> m t
parseTimeText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Text Text
P.takeText)


-- returns a list of pair of bookmark with tags merged into a string
allUserBookmarks :: Key User -> DB [(Entity Bookmark, Text)]
allUserBookmarks :: Key User -> DB [(Entity Bookmark, Text)]
allUserBookmarks Key User
user =
  (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (forall a. a -> Maybe a -> a
fromMaybe Text
"" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Value a -> a
unValue) forall a b. (a -> b) -> a -> b
$
  forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select forall a b. (a -> b) -> a -> b
$ do
    SqlExpr (Entity Bookmark)
b <- forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @Bookmark)
    SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key User) => EntityField Bookmark typ
BookmarkUserId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key User
user)
    [SqlExpr OrderBy] -> SqlQuery ()
orderBy [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
asc (SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ UTCTime) => EntityField Bookmark typ
BookmarkTime)]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity Bookmark)
b, forall a.
PersistField a =>
SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value (Maybe a))
subSelect forall a b. (a -> b) -> a -> b
$ forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SqlExpr (Entity BookmarkTag)
t -> do
             SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity Bookmark)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId)
             forall a. ToSomeValues a => a -> SqlQuery ()
groupBy (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId)
             [SqlExpr OrderBy] -> SqlQuery ()
orderBy [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
asc (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Int) => EntityField BookmarkTag typ
BookmarkTagSeq)]
             forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
PersistField a =>
SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Text)
sqliteGroupConcat (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag) (forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Text
" "))

parseSearchQuery ::
  (Text -> SqlExpr (Value Bool))
  -> Text
  -> Maybe (SqlQuery ())
parseSearchQuery :: (Text -> SqlExpr (Value Bool)) -> Text -> Maybe (SqlQuery ())
parseSearchQuery Text -> SqlExpr (Value Bool)
toExpr =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SqlExpr (Value Bool) -> SqlQuery ()
where_ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Parser a -> Text -> Either String a
P.parseOnly Parser Text (SqlExpr (Value Bool))
andE
  where
    andE :: Parser Text (SqlExpr (Value Bool))
andE = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
(&&.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 (Parser ()
P.skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text (SqlExpr (Value Bool))
orE forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (SqlExpr (Value Bool))
tokenTermE)
    orE :: Parser Text (SqlExpr (Value Bool))
orE = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
(||.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (SqlExpr (Value Bool))
tokenTermE forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`P.sepBy1` Char -> Parser Char
P.char Char
'|'
    tokenTermE :: Parser Text (SqlExpr (Value Bool))
tokenTermE = Parser Text (SqlExpr (Value Bool))
-> Parser Text (SqlExpr (Value Bool))
negE Parser Text (SqlExpr (Value Bool))
termE forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (SqlExpr (Value Bool))
termE
      where
        negE :: Parser Text (SqlExpr (Value Bool))
-> Parser Text (SqlExpr (Value Bool))
negE Parser Text (SqlExpr (Value Bool))
p = SqlExpr (Value Bool) -> SqlExpr (Value Bool)
not_ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
P.char Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text (SqlExpr (Value Bool))
p)
        termE :: Parser Text (SqlExpr (Value Bool))
termE = Text -> SqlExpr (Value Bool)
toExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
fieldTerm forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
quotedTerm forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
simpleTerm)
        fieldTerm :: Parser Text Text
fieldTerm = forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Parser Text Text
simpleTerm, Text -> Parser Text Text
P.string Text
":", Parser Text Text
quotedTerm forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
simpleTerm]
        quotedTerm :: Parser Text Text
quotedTerm = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
PC.between (Char -> Parser Char
P.char Char
'"') (Char -> Parser Char
P.char Char
'"') ((Char -> Bool) -> Parser Text Text
P.takeWhile1 (forall a. Eq a => a -> a -> Bool
/= Char
'"'))
        simpleTerm :: Parser Text Text
simpleTerm = (Char -> Bool) -> Parser Text Text
P.takeWhile1 (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
':' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'|')

parseTimeText :: (TI.ParseTime t, MonadFail m, Alternative m) => Text -> m t
parseTimeText :: forall t (m :: * -> *).
(ParseTime t, MonadFail m, Alternative m) =>
Text -> m t
parseTimeText Text
t =
  forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum forall a b. (a -> b) -> a -> b
$
  forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale) (forall mono. MonoFoldable mono => mono -> [Element mono]
unpack Text
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  [ String
"%-m/%-d/%Y"    , String
"%-m/%-d/%Y%z"    , String
"%-m/%-d/%Y%Z"     -- 12/31/2018
  , String
"%Y-%-m-%-d"    , String
"%Y-%-m-%-d%z"    , String
"%Y-%-m-%-d%Z"     -- 2018-12-31
  , String
"%Y-%-m-%-dT%T" , String
"%Y-%-m-%-dT%T%z" , String
"%Y-%-m-%-dT%T%Z"  -- 2018-12-31T06:40:53
  , String
"%s"                                                     -- 1535932800
  ]

withTags :: Key Bookmark -> DB [Entity BookmarkTag]
withTags :: Key Bookmark -> DB [Entity BookmarkTag]
withTags Key Bookmark
key = forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. Key Bookmark
key] [forall record typ. EntityField record typ -> SelectOpt record
Asc forall typ. (typ ~ Int) => EntityField BookmarkTag typ
BookmarkTagSeq]

-- Note List Query


getNote :: Key User -> NtSlug -> DB (Maybe (Entity Note))
getNote :: Key User -> NtSlug -> DB (Maybe (Entity Note))
getNote Key User
userKey NtSlug
slug =
  forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst [forall typ. (typ ~ Key User) => EntityField Note typ
NoteUserId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. Key User
userKey, forall typ. (typ ~ NtSlug) => EntityField Note typ
NoteSlug forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. NtSlug
slug] []

getNoteList :: Key User -> Maybe Text -> SharedP -> Limit -> Page -> DB (Int, [Entity Note])
getNoteList :: Key User
-> Maybe Text
-> SharedP
-> Int64
-> Int64
-> DB (Int, [Entity Note])
getNoteList Key User
key Maybe Text
mquery SharedP
sharedp Int64
limit' Int64
page =
  (,) -- total count
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall mono.
(MonoFoldable mono, Num (Element mono)) =>
mono -> Element mono
sum forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Value a -> a
unValue)
      (forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select forall a b. (a -> b) -> a -> b
$ do
      SqlExpr (Entity Note)
b <- forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @Note)
      SqlExpr (Entity Note) -> SqlQuery ()
_whereClause SqlExpr (Entity Note)
b
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Num a => SqlExpr (Value a)
countRows)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select forall a b. (a -> b) -> a -> b
$ do
       SqlExpr (Entity Note)
b <- forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @Note)
       SqlExpr (Entity Note) -> SqlQuery ()
_whereClause SqlExpr (Entity Note)
b
       [SqlExpr OrderBy] -> SqlQuery ()
orderBy [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
desc (SqlExpr (Entity Note)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ UTCTime) => EntityField Note typ
NoteCreated)]
       Int64 -> SqlQuery ()
limit Int64
limit'
       Int64 -> SqlQuery ()
offset ((Int64
page forall a. Num a => a -> a -> a
- Int64
1) forall a. Num a => a -> a -> a
* Int64
limit')
       forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlExpr (Entity Note)
b)
  where
    _whereClause :: SqlExpr (Entity Note) -> SqlQuery ()
_whereClause SqlExpr (Entity Note)
b = do
      SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Note)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key User) => EntityField Note typ
NoteUserId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key User
key)
      -- search
      forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ ((Text -> SqlExpr (Value Bool)) -> Text -> Maybe (SqlQuery ())
parseSearchQuery (SqlExpr (Entity Note) -> Text -> SqlExpr (Value Bool)
toLikeExpr SqlExpr (Entity Note)
b) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
mquery)
      case SharedP
sharedp of
        SharedP
SharedAll -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        SharedP
SharedPublic ->  SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Note)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Bool) => EntityField Note typ
NoteShared forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Bool
True)
        SharedP
SharedPrivate -> SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Note)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Bool) => EntityField Note typ
NoteShared forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Bool
False)

    toLikeExpr :: SqlExpr (Entity Note) -> Text -> SqlExpr (Value Bool)
    toLikeExpr :: SqlExpr (Entity Note) -> Text -> SqlExpr (Value Bool)
toLikeExpr SqlExpr (Entity Note)
b Text
term = forall b a. b -> Either a b -> b
fromRight SqlExpr (Value Bool)
p_allFields (forall a. Parser a -> Text -> Either String a
P.parseOnly Parser Text (SqlExpr (Value Bool))
p_onefield Text
term)
      where
        wild :: s -> SqlExpr (Value s)
wild s
s = forall s. SqlString s => SqlExpr (Value s)
(%) forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
++. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val s
s forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
++. forall s. SqlString s => SqlExpr (Value s)
(%)
        toLikeN :: EntityField Note Text -> Text -> SqlExpr (Value Bool)
toLikeN EntityField Note Text
field Text
s = SqlExpr (Entity Note)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Note Text
field forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
`like` forall {s}. SqlString s => s -> SqlExpr (Value s)
wild Text
s
        p_allFields :: SqlExpr (Value Bool)
p_allFields = EntityField Note Text -> Text -> SqlExpr (Value Bool)
toLikeN forall typ. (typ ~ Text) => EntityField Note typ
NoteTitle Text
term SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
||. EntityField Note Text -> Text -> SqlExpr (Value Bool)
toLikeN forall typ. (typ ~ Text) => EntityField Note typ
NoteText Text
term
        p_onefield :: Parser Text (SqlExpr (Value Bool))
p_onefield = Parser Text (SqlExpr (Value Bool))
p_title forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (SqlExpr (Value Bool))
p_text forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (SqlExpr (Value Bool))
p_after forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (SqlExpr (Value Bool))
p_before
          where
            p_title :: Parser Text (SqlExpr (Value Bool))
p_title = Parser Text Text
"title:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EntityField Note Text -> Text -> SqlExpr (Value Bool)
toLikeN forall typ. (typ ~ Text) => EntityField Note typ
NoteTitle) Parser Text Text
P.takeText
            p_text :: Parser Text (SqlExpr (Value Bool))
p_text = Parser Text Text
"description:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EntityField Note Text -> Text -> SqlExpr (Value Bool)
toLikeN forall typ. (typ ~ Text) => EntityField Note typ
NoteText) Parser Text Text
P.takeText
            p_after :: Parser Text (SqlExpr (Value Bool))
p_after  = Parser Text Text
"after:"  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SqlExpr (Entity Note)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ UTCTime) => EntityField Note typ
NoteCreated forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
>=.) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val) (forall t (m :: * -> *).
(ParseTime t, MonadFail m, Alternative m) =>
Text -> m t
parseTimeText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Text Text
P.takeText)
            p_before :: Parser Text (SqlExpr (Value Bool))
p_before = Parser Text Text
"before:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SqlExpr (Entity Note)
b forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ UTCTime) => EntityField Note typ
NoteCreated forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
<=.) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val) (forall t (m :: * -> *).
(ParseTime t, MonadFail m, Alternative m) =>
Text -> m t
parseTimeText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Text Text
P.takeText)

-- Bookmark Files

mkBookmarkTags :: Key User -> Key Bookmark -> [Tag] -> [BookmarkTag]
mkBookmarkTags :: Key User -> Key Bookmark -> [Text] -> [BookmarkTag]
mkBookmarkTags Key User
userId Key Bookmark
bookmarkId [Text]
tags =
  (\(Int
i, Text
tag) -> Key User -> Text -> Key Bookmark -> Int -> BookmarkTag
BookmarkTag Key User
userId Text
tag Key Bookmark
bookmarkId Int
i) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip [Int
1 ..] [Text]
tags


fileBookmarkToBookmark :: UserId -> FileBookmark -> IO Bookmark
fileBookmarkToBookmark :: Key User -> FileBookmark -> IO Bookmark
fileBookmarkToBookmark Key User
user FileBookmark {Bool
Maybe Bool
Maybe Text
UTCTime
Text
fileBookmarkTags :: FileBookmark -> Text
fileBookmarkArchiveHref :: FileBookmark -> Maybe Text
fileBookmarkSelected :: FileBookmark -> Maybe Bool
fileBookmarkToRead :: FileBookmark -> Bool
fileBookmarkShared :: FileBookmark -> Bool
fileBookmarkTime :: FileBookmark -> UTCTime
fileBookmarkExtended :: FileBookmark -> Text
fileBookmarkDescription :: FileBookmark -> Text
fileBookmarkHref :: FileBookmark -> Text
fileBookmarkTags :: Text
fileBookmarkArchiveHref :: Maybe Text
fileBookmarkSelected :: Maybe Bool
fileBookmarkToRead :: Bool
fileBookmarkShared :: Bool
fileBookmarkTime :: UTCTime
fileBookmarkExtended :: Text
fileBookmarkDescription :: Text
fileBookmarkHref :: Text
..} = do
  BmSlug
slug <- IO BmSlug
mkBmSlug
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    Bookmark
    { bookmarkUserId :: Key User
bookmarkUserId = Key User
user
    , bookmarkSlug :: BmSlug
bookmarkSlug = BmSlug
slug
    , bookmarkHref :: Text
bookmarkHref = Text
fileBookmarkHref
    , bookmarkDescription :: Text
bookmarkDescription = Text
fileBookmarkDescription
    , bookmarkExtended :: Text
bookmarkExtended = Text
fileBookmarkExtended
    , bookmarkTime :: UTCTime
bookmarkTime = UTCTime
fileBookmarkTime
    , bookmarkShared :: Bool
bookmarkShared = Bool
fileBookmarkShared
    , bookmarkToRead :: Bool
bookmarkToRead = Bool
fileBookmarkToRead
    , bookmarkSelected :: Bool
bookmarkSelected = forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== Maybe Bool
fileBookmarkSelected
    , bookmarkArchiveHref :: Maybe Text
bookmarkArchiveHref = Maybe Text
fileBookmarkArchiveHref
    }

bookmarkTofileBookmark :: Bookmark -> Text -> FileBookmark
bookmarkTofileBookmark :: Bookmark -> Text -> FileBookmark
bookmarkTofileBookmark Bookmark {Bool
Maybe Text
UTCTime
Text
Key User
BmSlug
bookmarkArchiveHref :: Maybe Text
bookmarkSelected :: Bool
bookmarkToRead :: Bool
bookmarkShared :: Bool
bookmarkTime :: UTCTime
bookmarkExtended :: Text
bookmarkDescription :: Text
bookmarkHref :: Text
bookmarkSlug :: BmSlug
bookmarkUserId :: Key User
bookmarkArchiveHref :: Bookmark -> Maybe Text
bookmarkSelected :: Bookmark -> Bool
bookmarkToRead :: Bookmark -> Bool
bookmarkShared :: Bookmark -> Bool
bookmarkTime :: Bookmark -> UTCTime
bookmarkExtended :: Bookmark -> Text
bookmarkDescription :: Bookmark -> Text
bookmarkHref :: Bookmark -> Text
bookmarkSlug :: Bookmark -> BmSlug
bookmarkUserId :: Bookmark -> Key User
..} Text
tags =
    FileBookmark
    { fileBookmarkHref :: Text
fileBookmarkHref = Text
bookmarkHref
    , fileBookmarkDescription :: Text
fileBookmarkDescription = Text
bookmarkDescription
    , fileBookmarkExtended :: Text
fileBookmarkExtended = Text
bookmarkExtended
    , fileBookmarkTime :: UTCTime
fileBookmarkTime = UTCTime
bookmarkTime
    , fileBookmarkShared :: Bool
fileBookmarkShared = Bool
bookmarkShared
    , fileBookmarkToRead :: Bool
fileBookmarkToRead = Bool
bookmarkToRead
    , fileBookmarkSelected :: Maybe Bool
fileBookmarkSelected = forall a. a -> Maybe a
Just Bool
bookmarkSelected
    , fileBookmarkArchiveHref :: Maybe Text
fileBookmarkArchiveHref = Maybe Text
bookmarkArchiveHref
    , fileBookmarkTags :: Text
fileBookmarkTags = Text
tags
    }

data FFBookmarkNode = FFBookmarkNode
  { FFBookmarkNode -> Maybe [FFBookmarkNode]
firefoxBookmarkChildren :: Maybe [FFBookmarkNode]
  , FFBookmarkNode -> POSIXTime
firefoxBookmarkDateAdded :: !TI.POSIXTime
  , FFBookmarkNode -> Text
firefoxBookmarkGuid :: !Text
  , FFBookmarkNode -> Maybe Text
firefoxBookmarkIconUri :: !(Maybe Text)
  , FFBookmarkNode -> Int
firefoxBookmarkId :: !Int
  , FFBookmarkNode -> Int
firefoxBookmarkIndex :: !Int
  , FFBookmarkNode -> POSIXTime
firefoxBookmarkLastModified :: !TI.POSIXTime
  , FFBookmarkNode -> Maybe Text
firefoxBookmarkRoot :: !(Maybe Text)
  , FFBookmarkNode -> Text
firefoxBookmarkTitle :: !Text
  , FFBookmarkNode -> Text
firefoxBookmarkType :: !Text
  , FFBookmarkNode -> Int
firefoxBookmarkTypeCode :: !Int
  , FFBookmarkNode -> Maybe Text
firefoxBookmarkUri :: !(Maybe Text)
  } deriving (Int -> FFBookmarkNode -> ShowS
[FFBookmarkNode] -> ShowS
FFBookmarkNode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FFBookmarkNode] -> ShowS
$cshowList :: [FFBookmarkNode] -> ShowS
show :: FFBookmarkNode -> String
$cshow :: FFBookmarkNode -> String
showsPrec :: Int -> FFBookmarkNode -> ShowS
$cshowsPrec :: Int -> FFBookmarkNode -> ShowS
Show, FFBookmarkNode -> FFBookmarkNode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FFBookmarkNode -> FFBookmarkNode -> Bool
$c/= :: FFBookmarkNode -> FFBookmarkNode -> Bool
== :: FFBookmarkNode -> FFBookmarkNode -> Bool
$c== :: FFBookmarkNode -> FFBookmarkNode -> Bool
Eq, Typeable, Eq FFBookmarkNode
FFBookmarkNode -> FFBookmarkNode -> Bool
FFBookmarkNode -> FFBookmarkNode -> Ordering
FFBookmarkNode -> FFBookmarkNode -> FFBookmarkNode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FFBookmarkNode -> FFBookmarkNode -> FFBookmarkNode
$cmin :: FFBookmarkNode -> FFBookmarkNode -> FFBookmarkNode
max :: FFBookmarkNode -> FFBookmarkNode -> FFBookmarkNode
$cmax :: FFBookmarkNode -> FFBookmarkNode -> FFBookmarkNode
>= :: FFBookmarkNode -> FFBookmarkNode -> Bool
$c>= :: FFBookmarkNode -> FFBookmarkNode -> Bool
> :: FFBookmarkNode -> FFBookmarkNode -> Bool
$c> :: FFBookmarkNode -> FFBookmarkNode -> Bool
<= :: FFBookmarkNode -> FFBookmarkNode -> Bool
$c<= :: FFBookmarkNode -> FFBookmarkNode -> Bool
< :: FFBookmarkNode -> FFBookmarkNode -> Bool
$c< :: FFBookmarkNode -> FFBookmarkNode -> Bool
compare :: FFBookmarkNode -> FFBookmarkNode -> Ordering
$ccompare :: FFBookmarkNode -> FFBookmarkNode -> Ordering
Ord)

instance FromJSON FFBookmarkNode where
  parseJSON :: Value -> Parser FFBookmarkNode
parseJSON (Object Object
o) =
    Maybe [FFBookmarkNode]
-> POSIXTime
-> Text
-> Maybe Text
-> Int
-> Int
-> POSIXTime
-> Maybe Text
-> Text
-> Text
-> Int
-> Maybe Text
-> FFBookmarkNode
FFBookmarkNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"children") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dateAdded") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guid" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"iconUri") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lastModified") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"root") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"typeCode") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"uri")
  parseJSON Value
_ = forall a. String -> Parser a
A.parseFail String
"bad parse"

firefoxBookmarkNodeToBookmark :: UserId -> FFBookmarkNode -> IO [Bookmark]
firefoxBookmarkNodeToBookmark :: Key User -> FFBookmarkNode -> IO [Bookmark]
firefoxBookmarkNodeToBookmark Key User
user FFBookmarkNode {Int
Maybe [FFBookmarkNode]
Maybe Text
Text
POSIXTime
firefoxBookmarkUri :: Maybe Text
firefoxBookmarkTypeCode :: Int
firefoxBookmarkType :: Text
firefoxBookmarkTitle :: Text
firefoxBookmarkRoot :: Maybe Text
firefoxBookmarkLastModified :: POSIXTime
firefoxBookmarkIndex :: Int
firefoxBookmarkId :: Int
firefoxBookmarkIconUri :: Maybe Text
firefoxBookmarkGuid :: Text
firefoxBookmarkDateAdded :: POSIXTime
firefoxBookmarkChildren :: Maybe [FFBookmarkNode]
firefoxBookmarkUri :: FFBookmarkNode -> Maybe Text
firefoxBookmarkTypeCode :: FFBookmarkNode -> Int
firefoxBookmarkType :: FFBookmarkNode -> Text
firefoxBookmarkTitle :: FFBookmarkNode -> Text
firefoxBookmarkRoot :: FFBookmarkNode -> Maybe Text
firefoxBookmarkLastModified :: FFBookmarkNode -> POSIXTime
firefoxBookmarkIndex :: FFBookmarkNode -> Int
firefoxBookmarkId :: FFBookmarkNode -> Int
firefoxBookmarkIconUri :: FFBookmarkNode -> Maybe Text
firefoxBookmarkGuid :: FFBookmarkNode -> Text
firefoxBookmarkDateAdded :: FFBookmarkNode -> POSIXTime
firefoxBookmarkChildren :: FFBookmarkNode -> Maybe [FFBookmarkNode]
..} =
  case Int
firefoxBookmarkTypeCode of
    Int
1 -> do
      BmSlug
slug <- IO BmSlug
mkBmSlug
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        [ Bookmark
          { bookmarkUserId :: Key User
bookmarkUserId = Key User
user
          , bookmarkSlug :: BmSlug
bookmarkSlug = BmSlug
slug
          , bookmarkHref :: Text
bookmarkHref = forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
firefoxBookmarkUri
          , bookmarkDescription :: Text
bookmarkDescription = Text
firefoxBookmarkTitle
          , bookmarkExtended :: Text
bookmarkExtended = Text
""
          , bookmarkTime :: UTCTime
bookmarkTime = POSIXTime -> UTCTime
TI.posixSecondsToUTCTime (POSIXTime
firefoxBookmarkDateAdded forall a. Fractional a => a -> a -> a
/ POSIXTime
1000000)
          , bookmarkShared :: Bool
bookmarkShared = Bool
True
          , bookmarkToRead :: Bool
bookmarkToRead = Bool
False
          , bookmarkSelected :: Bool
bookmarkSelected = Bool
False
          , bookmarkArchiveHref :: Maybe Text
bookmarkArchiveHref = forall a. Maybe a
Nothing
          }
        ]
    Int
2 ->
      forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
        (Key User -> FFBookmarkNode -> IO [Bookmark]
firefoxBookmarkNodeToBookmark Key User
user)
        (forall a. a -> Maybe a -> a
fromMaybe [] Maybe [FFBookmarkNode]
firefoxBookmarkChildren)
    Int
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []


insertFileBookmarks :: Key User -> FilePath -> DB (Either String Int)
insertFileBookmarks :: Key User -> String -> DB (Either String Int)
insertFileBookmarks Key User
userId String
bookmarkFile = do
  Either String [FileBookmark]
mfmarks <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
String -> m (Either String [FileBookmark])
readFileBookmarks String
bookmarkFile
  case Either String [FileBookmark]
mfmarks of
    Left String
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
e
    Right [FileBookmark]
fmarks -> do
      [Bookmark]
bmarks <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Key User -> FileBookmark -> IO Bookmark
fileBookmarkToBookmark Key User
userId) [FileBookmark]
fmarks
      [Maybe (Key Bookmark)]
mbids <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Maybe (Key record))
insertUnique [Bookmark]
bmarks
      forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
(Element mono -> m ()) -> mono -> m ()
mapM_ (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Maybe (Key record))
insertUnique) forall a b. (a -> b) -> a -> b
$
        forall mono m.
(MonoFoldable mono, Monoid m) =>
(Element mono -> m) -> mono -> m
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Key User -> Key Bookmark -> [Text] -> [BookmarkTag]
mkBookmarkTags Key User
userId)) forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) t.
(IsSequence (f (Maybe t)), Functor f,
 Element (f (Maybe t)) ~ Maybe t) =>
f (Maybe t) -> f t
catMaybes forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith
          (\Maybe (Key Bookmark)
mbid [Text]
tags -> (, [Text]
tags) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Key Bookmark)
mbid)
          [Maybe (Key Bookmark)]
mbids
          (FileBookmark -> [Text]
extractTags forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FileBookmark]
fmarks)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall mono. MonoFoldable mono => mono -> Int
length [Bookmark]
bmarks)

  where
    extractTags :: FileBookmark -> [Text]
extractTags = forall t. Textual t => t -> [t]
words forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FileBookmark -> Text
fileBookmarkTags

insertFFBookmarks :: Key User -> FilePath -> DB (Either String Int)
insertFFBookmarks :: Key User -> String -> DB (Either String Int)
insertFFBookmarks Key User
userId String
bookmarkFile = do
  Either String FFBookmarkNode
mfmarks <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
String -> m (Either String FFBookmarkNode)
readFFBookmarks String
bookmarkFile
  case Either String FFBookmarkNode
mfmarks of
    Left String
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
e
    Right FFBookmarkNode
fmarks -> do
      [Bookmark]
bmarks <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Key User -> FFBookmarkNode -> IO [Bookmark]
firefoxBookmarkNodeToBookmark Key User
userId FFBookmarkNode
fmarks
      forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
(Element mono -> m ()) -> mono -> m ()
mapM_ (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Maybe (Key record))
insertUnique) [Bookmark]
bmarks
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall mono. MonoFoldable mono => mono -> Int
length [Bookmark]
bmarks)


readFileBookmarks :: MonadIO m => FilePath -> m (Either String [FileBookmark])
readFileBookmarks :: forall (m :: * -> *).
MonadIO m =>
String -> m (Either String [FileBookmark])
readFileBookmarks String
fpath =
  forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall lazy strict. LazySequence lazy strict => strict -> lazy
fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => String -> m ByteString
readFile String
fpath

readFFBookmarks :: MonadIO m => FilePath -> m (Either String FFBookmarkNode)
readFFBookmarks :: forall (m :: * -> *).
MonadIO m =>
String -> m (Either String FFBookmarkNode)
readFFBookmarks String
fpath =
  forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall lazy strict. LazySequence lazy strict => strict -> lazy
fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => String -> m ByteString
readFile String
fpath

exportFileBookmarks :: Key User -> FilePath -> DB ()
exportFileBookmarks :: Key User -> String -> DB ()
exportFileBookmarks Key User
user String
fpath =
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ToJSON a => String -> a -> IO ()
A.encodeFile String
fpath forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Key User -> DB [FileBookmark]
getFileBookmarks Key User
user

getFileBookmarks :: Key User -> DB [FileBookmark]
getFileBookmarks :: Key User -> DB [FileBookmark]
getFileBookmarks Key User
user = do
  [(Entity Bookmark, Text)]
marks <- Key User -> DB [(Entity Bookmark, Text)]
allUserBookmarks Key User
user
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Entity Bookmark
bm, Text
t) -> Bookmark -> Text -> FileBookmark
bookmarkTofileBookmark (forall record. Entity record -> record
entityVal Entity Bookmark
bm) Text
t) [(Entity Bookmark, Text)]
marks

data TagCloudMode
  = TagCloudModeTop Bool Int          -- { mode: "top", value: 200 }
  | TagCloudModeLowerBound Bool Int   -- { mode: "lowerBound", value: 20 }
  | TagCloudModeRelated Bool [Tag]
  | TagCloudModeNone
  deriving (Int -> TagCloudMode -> ShowS
[TagCloudMode] -> ShowS
TagCloudMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagCloudMode] -> ShowS
$cshowList :: [TagCloudMode] -> ShowS
show :: TagCloudMode -> String
$cshow :: TagCloudMode -> String
showsPrec :: Int -> TagCloudMode -> ShowS
$cshowsPrec :: Int -> TagCloudMode -> ShowS
Show, TagCloudMode -> TagCloudMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagCloudMode -> TagCloudMode -> Bool
$c/= :: TagCloudMode -> TagCloudMode -> Bool
== :: TagCloudMode -> TagCloudMode -> Bool
$c== :: TagCloudMode -> TagCloudMode -> Bool
Eq, ReadPrec [TagCloudMode]
ReadPrec TagCloudMode
Int -> ReadS TagCloudMode
ReadS [TagCloudMode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagCloudMode]
$creadListPrec :: ReadPrec [TagCloudMode]
readPrec :: ReadPrec TagCloudMode
$creadPrec :: ReadPrec TagCloudMode
readList :: ReadS [TagCloudMode]
$creadList :: ReadS [TagCloudMode]
readsPrec :: Int -> ReadS TagCloudMode
$creadsPrec :: Int -> ReadS TagCloudMode
Read, forall x. Rep TagCloudMode x -> TagCloudMode
forall x. TagCloudMode -> Rep TagCloudMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagCloudMode x -> TagCloudMode
$cfrom :: forall x. TagCloudMode -> Rep TagCloudMode x
Generic)

isExpanded :: TagCloudMode -> Bool
isExpanded :: TagCloudMode -> Bool
isExpanded (TagCloudModeTop Bool
e Int
_) = Bool
e
isExpanded (TagCloudModeLowerBound Bool
e Int
_) = Bool
e
isExpanded (TagCloudModeRelated Bool
e [Text]
_) = Bool
e
isExpanded TagCloudMode
TagCloudModeNone = Bool
False

instance FromJSON TagCloudMode where
  parseJSON :: Value -> Parser TagCloudMode
parseJSON (Object Object
o) =
    case forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"mode" Object
o of
      Just (String Text
"top") -> Bool -> Int -> TagCloudMode
TagCloudModeTop forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expanded" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      Just (String Text
"lowerBound") -> Bool -> Int -> TagCloudMode
TagCloudModeLowerBound forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expanded" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      Just (String Text
"related") -> Bool -> [Text] -> TagCloudMode
TagCloudModeRelated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expanded" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. Textual t => t -> [t]
words (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value")
      Just (String Text
"none") -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TagCloudMode
TagCloudModeNone
      Maybe Value
_ -> forall a. String -> Parser a
A.parseFail String
"bad parse"
  parseJSON Value
_ = forall a. String -> Parser a
A.parseFail String
"bad parse"

instance ToJSON TagCloudMode where
  toJSON :: TagCloudMode -> Value
toJSON (TagCloudModeTop Bool
e Int
i) =
    [Pair] -> Value
object [ Key
"mode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"top"
           , Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Int
i
           , Key
"expanded" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool -> Value
Bool Bool
e
           ]
  toJSON (TagCloudModeLowerBound Bool
e Int
i) =
    [Pair] -> Value
object [ Key
"mode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"lowerBound"
           , Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Int
i
           , Key
"expanded" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool -> Value
Bool Bool
e
           ]
  toJSON (TagCloudModeRelated Bool
e [Text]
tags) =
    [Pair] -> Value
object [ Key
"mode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"related"
           , Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords [Text]
tags)
           , Key
"expanded" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool -> Value
Bool Bool
e
           ]
  toJSON TagCloudMode
TagCloudModeNone =
    [Pair] -> Value
object [ Key
"mode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"none"
           , Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
Null
           , Key
"expanded" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool -> Value
Bool Bool
False
           ]


type Tag = Text

tagCountTop :: Key User -> Int -> DB [(Text, Int)]
tagCountTop :: Key User -> Int -> DB [(Text, Int)]
tagCountTop Key User
user Int
top =
    forall o seq.
(Ord o, SemiSequence seq) =>
(Element seq -> o) -> seq -> seq
sortOn (forall t. Textual t => t -> t
toLower forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a, b) -> a
fst) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. Value a -> a
unValue forall a. Value a -> a
unValue) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select forall a b. (a -> b) -> a -> b
$ do
      SqlExpr (Entity BookmarkTag)
t <- forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag)
      SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key User) => EntityField BookmarkTag typ
BookmarkTagUserId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key User
user)
      forall a. ToSomeValues a => a -> SqlQuery ()
groupBy (forall s. SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
lower_ forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag)
      let countRows' :: SqlExpr (Value Int)
countRows' = forall a. Num a => SqlExpr (Value a)
countRows
      [SqlExpr OrderBy] -> SqlQuery ()
orderBy [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
desc SqlExpr (Value Int)
countRows']
      Int64 -> SqlQuery ()
limit ((forall a b. (Integral a, Num b) => a -> b
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Integral a => a -> Integer
toInteger) Int
top)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag, SqlExpr (Value Int)
countRows')
    )

tagCountLowerBound :: Key User -> Int -> DB [(Text, Int)]
tagCountLowerBound :: Key User -> Int -> DB [(Text, Int)]
tagCountLowerBound Key User
user Int
lowerBound =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. Value a -> a
unValue forall a. Value a -> a
unValue) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select forall a b. (a -> b) -> a -> b
$ do
      SqlExpr (Entity BookmarkTag)
t <- forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag)
      SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key User) => EntityField BookmarkTag typ
BookmarkTagUserId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key User
user)
      forall a. ToSomeValues a => a -> SqlQuery ()
groupBy (forall s. SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
lower_ forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag)
      let countRows' :: SqlExpr (Value Int)
countRows' = forall a. Num a => SqlExpr (Value a)
countRows
      [SqlExpr OrderBy] -> SqlQuery ()
orderBy [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
asc (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag)]
      SqlExpr (Value Bool) -> SqlQuery ()
having (SqlExpr (Value Int)
countRows' forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
>=. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Int
lowerBound)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag, SqlExpr (Value Int)
countRows')
    )

tagCountRelated :: Key User -> [Tag] -> DB [(Text, Int)]
tagCountRelated :: Key User -> [Text] -> DB [(Text, Int)]
tagCountRelated Key User
user [Text]
tags =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. Value a -> a
unValue forall a. Value a -> a
unValue) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select forall a b. (a -> b) -> a -> b
$ do
      SqlExpr (Entity BookmarkTag)
t <- forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag)
      SqlExpr (Value Bool) -> SqlQuery ()
where_ forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\SqlExpr (Value Bool)
expr Text
tag ->
                SqlExpr (Value Bool)
expr SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&. SqlQuery () -> SqlExpr (Value Bool)
exists ( do
                          SqlExpr (Entity BookmarkTag)
u <- forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag)
                          SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity BookmarkTag)
u forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&.
                                 (SqlExpr (Entity BookmarkTag)
u forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
`like` forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Text
tag))))
          (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key User) => EntityField BookmarkTag typ
BookmarkTagUserId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key User
user)
          [Text]
tags
      forall a. ToSomeValues a => a -> SqlQuery ()
groupBy (forall s. SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
lower_ forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag)
      let countRows' :: SqlExpr (Value Int)
countRows' = forall a. Num a => SqlExpr (Value a)
countRows
      [SqlExpr OrderBy] -> SqlQuery ()
orderBy [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
asc forall a b. (a -> b) -> a -> b
$ forall s. SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
lower_ forall a b. (a -> b) -> a -> b
$ (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag)]
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity BookmarkTag)
t forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag, SqlExpr (Value Int)
countRows')
    )

-- Notes

fileNoteToNote :: UserId -> FileNote -> IO Note
fileNoteToNote :: Key User -> FileNote -> IO Note
fileNoteToNote Key User
user FileNote {Int
UTCTime
Text
fileNoteUpdatedAt :: FileNote -> UTCTime
fileNoteCreatedAt :: FileNote -> UTCTime
fileNoteLength :: FileNote -> Int
fileNoteText :: FileNote -> Text
fileNoteTitle :: FileNote -> Text
fileNoteId :: FileNote -> Text
fileNoteUpdatedAt :: UTCTime
fileNoteCreatedAt :: UTCTime
fileNoteLength :: Int
fileNoteText :: Text
fileNoteTitle :: Text
fileNoteId :: Text
..}  = do
  NtSlug
slug <- IO NtSlug
mkNtSlug
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    Note
    { noteUserId :: Key User
noteUserId = Key User
user
    , noteSlug :: NtSlug
noteSlug = NtSlug
slug
    , noteLength :: Int
noteLength = Int
fileNoteLength
    , noteTitle :: Text
noteTitle = Text
fileNoteTitle
    , noteText :: Text
noteText = Text
fileNoteText
    , noteIsMarkdown :: Bool
noteIsMarkdown = Bool
False
    , noteShared :: Bool
noteShared = Bool
False
    , noteCreated :: UTCTime
noteCreated = UTCTime
fileNoteCreatedAt
    , noteUpdated :: UTCTime
noteUpdated = UTCTime
fileNoteUpdatedAt
    }

insertDirFileNotes :: Key User -> FilePath -> DB (Either String Int)
insertDirFileNotes :: Key User -> String -> DB (Either String Int)
insertDirFileNotes Key User
userId String
noteDirectory = do
  Either String [FileNote]
mfnotes <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
String -> m (Either String [FileNote])
readFileNotes String
noteDirectory
  case Either String [FileNote]
mfnotes of
      Left String
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
e
      Right [FileNote]
fnotes -> do
        [Note]
notes <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Key User -> FileNote -> IO Note
fileNoteToNote Key User
userId) [FileNote]
fnotes
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Maybe (Key record))
insertUnique [Note]
notes
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall mono. MonoFoldable mono => mono -> Int
length [Note]
notes)
  where
    readFileNotes :: MonadIO m => FilePath -> m (Either String [FileNote])
    readFileNotes :: forall (m :: * -> *).
MonadIO m =>
String -> m (Either String [FileNote])
readFileNotes String
fdir = do
      [String]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
fdir)
      [ByteString]
noteBSS <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *). MonadIO m => String -> m ByteString
readFile forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String
fdir String -> ShowS
</>)) [String]
files
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall lazy strict. LazySequence lazy strict => strict -> lazy
fromStrict) [ByteString]
noteBSS)

-- AccountSettingsForm
data AccountSettingsForm = AccountSettingsForm
  { AccountSettingsForm -> Bool
_privateDefault :: Bool
  , AccountSettingsForm -> Bool
_archiveDefault :: Bool
  , AccountSettingsForm -> Bool
_privacyLock :: Bool
  } deriving (Int -> AccountSettingsForm -> ShowS
[AccountSettingsForm] -> ShowS
AccountSettingsForm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountSettingsForm] -> ShowS
$cshowList :: [AccountSettingsForm] -> ShowS
show :: AccountSettingsForm -> String
$cshow :: AccountSettingsForm -> String
showsPrec :: Int -> AccountSettingsForm -> ShowS
$cshowsPrec :: Int -> AccountSettingsForm -> ShowS
Show, AccountSettingsForm -> AccountSettingsForm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountSettingsForm -> AccountSettingsForm -> Bool
$c/= :: AccountSettingsForm -> AccountSettingsForm -> Bool
== :: AccountSettingsForm -> AccountSettingsForm -> Bool
$c== :: AccountSettingsForm -> AccountSettingsForm -> Bool
Eq, ReadPrec [AccountSettingsForm]
ReadPrec AccountSettingsForm
Int -> ReadS AccountSettingsForm
ReadS [AccountSettingsForm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AccountSettingsForm]
$creadListPrec :: ReadPrec [AccountSettingsForm]
readPrec :: ReadPrec AccountSettingsForm
$creadPrec :: ReadPrec AccountSettingsForm
readList :: ReadS [AccountSettingsForm]
$creadList :: ReadS [AccountSettingsForm]
readsPrec :: Int -> ReadS AccountSettingsForm
$creadsPrec :: Int -> ReadS AccountSettingsForm
Read, forall x. Rep AccountSettingsForm x -> AccountSettingsForm
forall x. AccountSettingsForm -> Rep AccountSettingsForm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccountSettingsForm x -> AccountSettingsForm
$cfrom :: forall x. AccountSettingsForm -> Rep AccountSettingsForm x
Generic)

instance FromJSON AccountSettingsForm where parseJSON :: Value -> Parser AccountSettingsForm
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON Options
gDefaultFormOptions
instance ToJSON AccountSettingsForm where toJSON :: AccountSettingsForm -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON Options
gDefaultFormOptions

toAccountSettingsForm :: User -> AccountSettingsForm
toAccountSettingsForm :: User -> AccountSettingsForm
toAccountSettingsForm User {Bool
Maybe HashedApiKey
Text
BCrypt
userPrivacyLock :: Bool
userArchiveDefault :: Bool
userPrivateDefault :: Bool
userApiToken :: Maybe HashedApiKey
userPasswordHash :: BCrypt
userName :: Text
userPrivacyLock :: User -> Bool
userArchiveDefault :: User -> Bool
userPrivateDefault :: User -> Bool
userApiToken :: User -> Maybe HashedApiKey
userPasswordHash :: User -> BCrypt
userName :: User -> Text
..} =
  AccountSettingsForm
  { _privateDefault :: Bool
_privateDefault = Bool
userPrivateDefault
  , _archiveDefault :: Bool
_archiveDefault = Bool
userArchiveDefault
  , _privacyLock :: Bool
_privacyLock = Bool
userPrivacyLock
  }

updateUserFromAccountSettingsForm :: Key User -> AccountSettingsForm -> DB ()
updateUserFromAccountSettingsForm :: Key User -> AccountSettingsForm -> DB ()
updateUserFromAccountSettingsForm Key User
userId AccountSettingsForm {Bool
_privacyLock :: Bool
_archiveDefault :: Bool
_privateDefault :: Bool
_privacyLock :: AccountSettingsForm -> Bool
_archiveDefault :: AccountSettingsForm -> Bool
_privateDefault :: AccountSettingsForm -> Bool
..} =
  forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
CP.update Key User
userId
  [ forall typ. (typ ~ Bool) => EntityField User typ
UserPrivateDefault forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
CP.=. Bool
_privateDefault
  , forall typ. (typ ~ Bool) => EntityField User typ
UserArchiveDefault forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
CP.=. Bool
_archiveDefault
  , forall typ. (typ ~ Bool) => EntityField User typ
UserPrivacyLock forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
CP.=. Bool
_privacyLock
  ]

-- BookmarkForm

data BookmarkForm = BookmarkForm
  { BookmarkForm -> Text
_url :: Text
  , BookmarkForm -> Maybe Text
_title :: Maybe Text
  , BookmarkForm -> Maybe Textarea
_description :: Maybe Textarea
  , BookmarkForm -> Maybe Text
_tags :: Maybe Text
  , BookmarkForm -> Maybe Bool
_private :: Maybe Bool
  , BookmarkForm -> Maybe Bool
_toread :: Maybe Bool
  , BookmarkForm -> Maybe Int64
_bid :: Maybe Int64
  , BookmarkForm -> Maybe BmSlug
_slug :: Maybe BmSlug
  , BookmarkForm -> Maybe Bool
_selected :: Maybe Bool
  , BookmarkForm -> Maybe UTCTimeStr
_time :: Maybe UTCTimeStr
  , BookmarkForm -> Maybe Text
_archiveUrl :: Maybe Text
  } deriving (Int -> BookmarkForm -> ShowS
[BookmarkForm] -> ShowS
BookmarkForm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BookmarkForm] -> ShowS
$cshowList :: [BookmarkForm] -> ShowS
show :: BookmarkForm -> String
$cshow :: BookmarkForm -> String
showsPrec :: Int -> BookmarkForm -> ShowS
$cshowsPrec :: Int -> BookmarkForm -> ShowS
Show, BookmarkForm -> BookmarkForm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BookmarkForm -> BookmarkForm -> Bool
$c/= :: BookmarkForm -> BookmarkForm -> Bool
== :: BookmarkForm -> BookmarkForm -> Bool
$c== :: BookmarkForm -> BookmarkForm -> Bool
Eq, ReadPrec [BookmarkForm]
ReadPrec BookmarkForm
Int -> ReadS BookmarkForm
ReadS [BookmarkForm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BookmarkForm]
$creadListPrec :: ReadPrec [BookmarkForm]
readPrec :: ReadPrec BookmarkForm
$creadPrec :: ReadPrec BookmarkForm
readList :: ReadS [BookmarkForm]
$creadList :: ReadS [BookmarkForm]
readsPrec :: Int -> ReadS BookmarkForm
$creadsPrec :: Int -> ReadS BookmarkForm
Read, forall x. Rep BookmarkForm x -> BookmarkForm
forall x. BookmarkForm -> Rep BookmarkForm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BookmarkForm x -> BookmarkForm
$cfrom :: forall x. BookmarkForm -> Rep BookmarkForm x
Generic)

instance FromJSON BookmarkForm where parseJSON :: Value -> Parser BookmarkForm
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON Options
gDefaultFormOptions
instance ToJSON BookmarkForm where toJSON :: BookmarkForm -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON Options
gDefaultFormOptions

gDefaultFormOptions :: A.Options
gDefaultFormOptions :: Options
gDefaultFormOptions = Options
A.defaultOptions { fieldLabelModifier :: ShowS
A.fieldLabelModifier = forall seq. IsSequence seq => Index seq -> seq -> seq
drop Int
1 }

toBookmarkFormList :: [(Entity Bookmark, Maybe Text)] -> [BookmarkForm]
toBookmarkFormList :: [(Entity Bookmark, Maybe Text)] -> [BookmarkForm]
toBookmarkFormList = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Entity Bookmark, Maybe Text) -> BookmarkForm
_toBookmarkForm'

_toBookmarkForm :: (Entity Bookmark, [Entity BookmarkTag]) -> BookmarkForm
_toBookmarkForm :: (Entity Bookmark, [Entity BookmarkTag]) -> BookmarkForm
_toBookmarkForm (Entity Bookmark
bm, [Entity BookmarkTag]
tags) =
  (Entity Bookmark, Maybe Text) -> BookmarkForm
_toBookmarkForm' (Entity Bookmark
bm, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BookmarkTag -> Text
bookmarkTagTag forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall record. Entity record -> record
entityVal) [Entity BookmarkTag]
tags)

_toBookmarkForm' :: (Entity Bookmark, Maybe Text) -> BookmarkForm
_toBookmarkForm' :: (Entity Bookmark, Maybe Text) -> BookmarkForm
_toBookmarkForm' (Entity Key Bookmark
bid Bookmark {Bool
Maybe Text
UTCTime
Text
Key User
BmSlug
bookmarkArchiveHref :: Maybe Text
bookmarkSelected :: Bool
bookmarkToRead :: Bool
bookmarkShared :: Bool
bookmarkTime :: UTCTime
bookmarkExtended :: Text
bookmarkDescription :: Text
bookmarkHref :: Text
bookmarkSlug :: BmSlug
bookmarkUserId :: Key User
bookmarkArchiveHref :: Bookmark -> Maybe Text
bookmarkSelected :: Bookmark -> Bool
bookmarkToRead :: Bookmark -> Bool
bookmarkShared :: Bookmark -> Bool
bookmarkTime :: Bookmark -> UTCTime
bookmarkExtended :: Bookmark -> Text
bookmarkDescription :: Bookmark -> Text
bookmarkHref :: Bookmark -> Text
bookmarkSlug :: Bookmark -> BmSlug
bookmarkUserId :: Bookmark -> Key User
..}, Maybe Text
tags) =
  BookmarkForm
  { _url :: Text
_url = Text
bookmarkHref
  , _title :: Maybe Text
_title = forall a. a -> Maybe a
Just Text
bookmarkDescription
  , _description :: Maybe Textarea
_description = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Textarea
Textarea forall a b. (a -> b) -> a -> b
$ Text
bookmarkExtended
  , _tags :: Maybe Text
_tags = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
tags
  , _private :: Maybe Bool
_private = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
bookmarkShared
  , _toread :: Maybe Bool
_toread = forall a. a -> Maybe a
Just Bool
bookmarkToRead
  , _bid :: Maybe Int64
_bid = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key Bookmark -> Int64
unBookmarkKey forall a b. (a -> b) -> a -> b
$ Key Bookmark
bid
  , _slug :: Maybe BmSlug
_slug = forall a. a -> Maybe a
Just BmSlug
bookmarkSlug
  , _selected :: Maybe Bool
_selected = forall a. a -> Maybe a
Just Bool
bookmarkSelected
  , _time :: Maybe UTCTimeStr
_time = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTimeStr
UTCTimeStr forall a b. (a -> b) -> a -> b
$ UTCTime
bookmarkTime
  , _archiveUrl :: Maybe Text
_archiveUrl = Maybe Text
bookmarkArchiveHref
  }


_toBookmark :: UserId -> BookmarkForm -> IO Bookmark
_toBookmark :: Key User -> BookmarkForm -> IO Bookmark
_toBookmark Key User
userId BookmarkForm {Maybe Bool
Maybe Int64
Maybe Text
Maybe Textarea
Maybe BmSlug
Maybe UTCTimeStr
Text
_archiveUrl :: Maybe Text
_time :: Maybe UTCTimeStr
_selected :: Maybe Bool
_slug :: Maybe BmSlug
_bid :: Maybe Int64
_toread :: Maybe Bool
_private :: Maybe Bool
_tags :: Maybe Text
_description :: Maybe Textarea
_title :: Maybe Text
_url :: Text
_archiveUrl :: BookmarkForm -> Maybe Text
_time :: BookmarkForm -> Maybe UTCTimeStr
_selected :: BookmarkForm -> Maybe Bool
_slug :: BookmarkForm -> Maybe BmSlug
_bid :: BookmarkForm -> Maybe Int64
_toread :: BookmarkForm -> Maybe Bool
_private :: BookmarkForm -> Maybe Bool
_tags :: BookmarkForm -> Maybe Text
_description :: BookmarkForm -> Maybe Textarea
_title :: BookmarkForm -> Maybe Text
_url :: BookmarkForm -> Text
..} = do
  UTCTime
time <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  BmSlug
slug <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO BmSlug
mkBmSlug forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe BmSlug
_slug
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    Bookmark
    { bookmarkUserId :: Key User
bookmarkUserId = Key User
userId
    , bookmarkSlug :: BmSlug
bookmarkSlug = BmSlug
slug
    , bookmarkHref :: Text
bookmarkHref = Text
_url
    , bookmarkDescription :: Text
bookmarkDescription = forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
_title
    , bookmarkExtended :: Text
bookmarkExtended = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Textarea -> Text
unTextarea Maybe Textarea
_description
    , bookmarkTime :: UTCTime
bookmarkTime = forall b a. b -> (a -> b) -> Maybe a -> b
maybe UTCTime
time UTCTimeStr -> UTCTime
unUTCTimeStr Maybe UTCTimeStr
_time
    , bookmarkShared :: Bool
bookmarkShared = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Bool -> Bool
not Maybe Bool
_private
    , bookmarkToRead :: Bool
bookmarkToRead = forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== Maybe Bool
_toread
    , bookmarkSelected :: Bool
bookmarkSelected = forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== Maybe Bool
_selected
    , bookmarkArchiveHref :: Maybe Text
bookmarkArchiveHref = Maybe Text
_archiveUrl
    }

fetchBookmarkByUrl :: Key User -> Maybe Text -> DB (Maybe (Entity Bookmark, [Entity BookmarkTag]))
fetchBookmarkByUrl :: Key User
-> Maybe Text -> DB (Maybe (Entity Bookmark, [Entity BookmarkTag]))
fetchBookmarkByUrl Key User
userId Maybe Text
murl = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  Entity Bookmark
bmark <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Key User -> Text -> Unique Bookmark
UniqueUserHref Key User
userId forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
murl)
  [Entity BookmarkTag]
btags <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Key Bookmark -> DB [Entity BookmarkTag]
withTags (forall record. Entity record -> Key record
entityKey Entity Bookmark
bmark)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Entity Bookmark
bmark, [Entity BookmarkTag]
btags)

data UpsertResult a = Created a | Updated a | Failed String
  deriving (Int -> UpsertResult a -> ShowS
forall a. Show a => Int -> UpsertResult a -> ShowS
forall a. Show a => [UpsertResult a] -> ShowS
forall a. Show a => UpsertResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpsertResult a] -> ShowS
$cshowList :: forall a. Show a => [UpsertResult a] -> ShowS
show :: UpsertResult a -> String
$cshow :: forall a. Show a => UpsertResult a -> String
showsPrec :: Int -> UpsertResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> UpsertResult a -> ShowS
Show, UpsertResult a -> UpsertResult a -> Bool
forall a. Eq a => UpsertResult a -> UpsertResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpsertResult a -> UpsertResult a -> Bool
$c/= :: forall a. Eq a => UpsertResult a -> UpsertResult a -> Bool
== :: UpsertResult a -> UpsertResult a -> Bool
$c== :: forall a. Eq a => UpsertResult a -> UpsertResult a -> Bool
Eq, forall a b. a -> UpsertResult b -> UpsertResult a
forall a b. (a -> b) -> UpsertResult a -> UpsertResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> UpsertResult b -> UpsertResult a
$c<$ :: forall a b. a -> UpsertResult b -> UpsertResult a
fmap :: forall a b. (a -> b) -> UpsertResult a -> UpsertResult b
$cfmap :: forall a b. (a -> b) -> UpsertResult a -> UpsertResult b
Functor)

maybeUpsertResult :: UpsertResult a -> Maybe a
maybeUpsertResult :: forall a. UpsertResult a -> Maybe a
maybeUpsertResult (Created a
a) = forall a. a -> Maybe a
Just a
a
maybeUpsertResult (Updated a
a) = forall a. a -> Maybe a
Just a
a
maybeUpsertResult UpsertResult a
_ = forall a. Maybe a
Nothing

upsertBookmark :: Key User -> Maybe (Key Bookmark) -> Bookmark -> [Text] -> DB (UpsertResult (Key Bookmark))
upsertBookmark :: Key User
-> Maybe (Key Bookmark)
-> Bookmark
-> [Text]
-> DB (UpsertResult (Key Bookmark))
upsertBookmark Key User
userId Maybe (Key Bookmark)
mbid Bookmark
bm [Text]
tags = do
  UpsertResult (Key Bookmark)
res <- case Maybe (Key Bookmark)
mbid of
    Just Key Bookmark
bid ->
      forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key Bookmark
bid forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Bookmark
prev_bm | Key User
userId forall a. Eq a => a -> a -> Bool
== Bookmark -> Key User
bookmarkUserId Bookmark
prev_bm ->
          Key Bookmark
-> Bookmark -> SqlPersistT m (UpsertResult (Key Bookmark))
replaceBookmark Key Bookmark
bid Bookmark
prev_bm
        Just Bookmark
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. String -> UpsertResult a
Failed String
"unauthorized")
        Maybe Bookmark
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. String -> UpsertResult a
Failed String
"not found")
    Maybe (Key Bookmark)
Nothing ->
      forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy (Key User -> Text -> Unique Bookmark
UniqueUserHref (Bookmark -> Key User
bookmarkUserId Bookmark
bm) (Bookmark -> Text
bookmarkHref Bookmark
bm)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (Entity Key Bookmark
bid Bookmark
prev_bm) -> Key Bookmark
-> Bookmark -> SqlPersistT m (UpsertResult (Key Bookmark))
replaceBookmark Key Bookmark
bid Bookmark
prev_bm
        Maybe (Entity Bookmark)
_ -> forall a. a -> UpsertResult a
Created forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert Bookmark
bm
  forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
mono -> (Element mono -> m ()) -> m ()
forM_ (forall a. UpsertResult a -> Maybe a
maybeUpsertResult UpsertResult (Key Bookmark)
res) (Key User -> Key Bookmark -> ReaderT SqlBackend m ()
insertTags (Bookmark -> Key User
bookmarkUserId Bookmark
bm)) 
  forall (f :: * -> *) a. Applicative f => a -> f a
pure UpsertResult (Key Bookmark)
res
  where
    prepareReplace :: Bookmark -> Bookmark
prepareReplace Bookmark
prev_bm =
      if Bookmark -> Text
bookmarkHref Bookmark
bm forall a. Eq a => a -> a -> Bool
/= Bookmark -> Text
bookmarkHref Bookmark
prev_bm
        then Bookmark
bm { bookmarkArchiveHref :: Maybe Text
bookmarkArchiveHref = forall a. Maybe a
Nothing }
        else Bookmark
bm { bookmarkArchiveHref :: Maybe Text
bookmarkArchiveHref = Bookmark -> Maybe Text
bookmarkArchiveHref Bookmark
prev_bm }
    replaceBookmark :: Key Bookmark
-> Bookmark -> SqlPersistT m (UpsertResult (Key Bookmark))
replaceBookmark Key Bookmark
bid Bookmark
prev_bm = do
      forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
replace Key Bookmark
bid (Bookmark -> Bookmark
prepareReplace Bookmark
prev_bm)
      forall {backend} {m :: * -> *}.
(BaseBackend backend ~ SqlBackend, MonadIO m,
 PersistQueryWrite backend) =>
Key Bookmark -> ReaderT backend m ()
deleteTags Key Bookmark
bid
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> UpsertResult a
Updated Key Bookmark
bid)
    deleteTags :: Key Bookmark -> ReaderT backend m ()
deleteTags Key Bookmark
bid =
      forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. Key Bookmark
bid]
    insertTags :: Key User -> Key Bookmark -> ReaderT SqlBackend m ()
insertTags Key User
userId' Key Bookmark
bid' =
      forall mono (f :: * -> *) b.
(MonoFoldable mono, Applicative f) =>
mono -> (Element mono -> f b) -> f ()
for_ (forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip [Int
1 ..] [Text]
tags) forall a b. (a -> b) -> a -> b
$
      \(Int
i, Text
tag) -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert forall a b. (a -> b) -> a -> b
$ Key User -> Text -> Key Bookmark -> Int -> BookmarkTag
BookmarkTag Key User
userId' Text
tag Key Bookmark
bid' Int
i

updateBookmarkArchiveUrl :: Key User -> Key Bookmark -> Maybe Text -> DB ()
updateBookmarkArchiveUrl :: Key User -> Key Bookmark -> Maybe Text -> DB ()
updateBookmarkArchiveUrl Key User
userId Key Bookmark
bid Maybe Text
marchiveUrl =
  forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> [Update record] -> ReaderT backend m ()
updateWhere
  [forall typ. (typ ~ Key User) => EntityField Bookmark typ
BookmarkUserId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. Key User
userId, forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. Key Bookmark
bid]
  [forall typ. (typ ~ Maybe Text) => EntityField Bookmark typ
BookmarkArchiveHref forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
CP.=. Maybe Text
marchiveUrl]

upsertNote :: Key User -> Maybe (Key Note) -> Note -> DB (UpsertResult (Key Note))
upsertNote :: Key User
-> Maybe (Key Note) -> Note -> DB (UpsertResult (Key Note))
upsertNote Key User
userId Maybe (Key Note)
mnid Note
note =
  case Maybe (Key Note)
mnid of
    Just Key Note
nid -> do
      forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key Note
nid forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Note
note' -> do
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key User
userId forall a. Eq a => a -> a -> Bool
/= Note -> Key User
noteUserId Note
note')
            (forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"unauthorized")
          forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
replace Key Note
nid Note
note
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> UpsertResult a
Updated Key Note
nid)
        Maybe Note
_ -> forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"not found"
    Maybe (Key Note)
Nothing -> do
      forall a. a -> UpsertResult a
Created forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert Note
note

-- * FileBookmarks

data FileBookmark = FileBookmark
  { FileBookmark -> Text
fileBookmarkHref :: !Text
  , FileBookmark -> Text
fileBookmarkDescription :: !Text
  , FileBookmark -> Text
fileBookmarkExtended :: !Text
  , FileBookmark -> UTCTime
fileBookmarkTime :: !UTCTime
  , FileBookmark -> Bool
fileBookmarkShared :: !Bool
  , FileBookmark -> Bool
fileBookmarkToRead :: !Bool
  , FileBookmark -> Maybe Bool
fileBookmarkSelected :: !(Maybe Bool)
  , FileBookmark -> Maybe Text
fileBookmarkArchiveHref :: !(Maybe Text)
  , FileBookmark -> Text
fileBookmarkTags :: !Text
  } deriving (Int -> FileBookmark -> ShowS
[FileBookmark] -> ShowS
FileBookmark -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileBookmark] -> ShowS
$cshowList :: [FileBookmark] -> ShowS
show :: FileBookmark -> String
$cshow :: FileBookmark -> String
showsPrec :: Int -> FileBookmark -> ShowS
$cshowsPrec :: Int -> FileBookmark -> ShowS
Show, FileBookmark -> FileBookmark -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileBookmark -> FileBookmark -> Bool
$c/= :: FileBookmark -> FileBookmark -> Bool
== :: FileBookmark -> FileBookmark -> Bool
$c== :: FileBookmark -> FileBookmark -> Bool
Eq, Typeable, Eq FileBookmark
FileBookmark -> FileBookmark -> Bool
FileBookmark -> FileBookmark -> Ordering
FileBookmark -> FileBookmark -> FileBookmark
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileBookmark -> FileBookmark -> FileBookmark
$cmin :: FileBookmark -> FileBookmark -> FileBookmark
max :: FileBookmark -> FileBookmark -> FileBookmark
$cmax :: FileBookmark -> FileBookmark -> FileBookmark
>= :: FileBookmark -> FileBookmark -> Bool
$c>= :: FileBookmark -> FileBookmark -> Bool
> :: FileBookmark -> FileBookmark -> Bool
$c> :: FileBookmark -> FileBookmark -> Bool
<= :: FileBookmark -> FileBookmark -> Bool
$c<= :: FileBookmark -> FileBookmark -> Bool
< :: FileBookmark -> FileBookmark -> Bool
$c< :: FileBookmark -> FileBookmark -> Bool
compare :: FileBookmark -> FileBookmark -> Ordering
$ccompare :: FileBookmark -> FileBookmark -> Ordering
Ord)

instance FromJSON FileBookmark where
  parseJSON :: Value -> Parser FileBookmark
parseJSON (Object Object
o) =
    Text
-> Text
-> Text
-> UTCTime
-> Bool
-> Bool
-> Maybe Bool
-> Maybe Text
-> Text
-> FileBookmark
FileBookmark forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"href" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"extended" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Text -> Bool
boolFromYesNo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"shared") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Text -> Bool
boolFromYesNo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"toread") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"selected") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"archive_url") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tags")
  parseJSON Value
_ = forall a. String -> Parser a
A.parseFail String
"bad parse"

instance ToJSON FileBookmark where
  toJSON :: FileBookmark -> Value
toJSON FileBookmark {Bool
Maybe Bool
Maybe Text
UTCTime
Text
fileBookmarkTags :: Text
fileBookmarkArchiveHref :: Maybe Text
fileBookmarkSelected :: Maybe Bool
fileBookmarkToRead :: Bool
fileBookmarkShared :: Bool
fileBookmarkTime :: UTCTime
fileBookmarkExtended :: Text
fileBookmarkDescription :: Text
fileBookmarkHref :: Text
fileBookmarkTags :: FileBookmark -> Text
fileBookmarkArchiveHref :: FileBookmark -> Maybe Text
fileBookmarkSelected :: FileBookmark -> Maybe Bool
fileBookmarkToRead :: FileBookmark -> Bool
fileBookmarkShared :: FileBookmark -> Bool
fileBookmarkTime :: FileBookmark -> UTCTime
fileBookmarkExtended :: FileBookmark -> Text
fileBookmarkDescription :: FileBookmark -> Text
fileBookmarkHref :: FileBookmark -> Text
..} =
    [Pair] -> Value
object
      [ Key
"href" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Text
fileBookmarkHref
      , Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Text
fileBookmarkDescription
      , Key
"extended" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Text
fileBookmarkExtended
      , Key
"time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON UTCTime
fileBookmarkTime
      , Key
"shared" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON (Bool -> Text
boolToYesNo Bool
fileBookmarkShared)
      , Key
"toread" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON (Bool -> Text
boolToYesNo Bool
fileBookmarkToRead)
      , Key
"selected" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Maybe Bool
fileBookmarkSelected
      , Key
"archive_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Maybe Text
fileBookmarkArchiveHref
      , Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Text
fileBookmarkTags
      ]

boolFromYesNo :: Text -> Bool
boolFromYesNo :: Text -> Bool
boolFromYesNo Text
"yes" = Bool
True
boolFromYesNo Text
_ = Bool
False

boolToYesNo :: Bool -> Text
boolToYesNo :: Bool -> Text
boolToYesNo Bool
True = Text
"yes"
boolToYesNo Bool
_ = Text
"no"

-- * FileNotes

data FileNote = FileNote
  { FileNote -> Text
fileNoteId :: !Text
  , FileNote -> Text
fileNoteTitle :: !Text
  , FileNote -> Text
fileNoteText :: !Text
  , FileNote -> Int
fileNoteLength :: !Int
  , FileNote -> UTCTime
fileNoteCreatedAt :: !UTCTime
  , FileNote -> UTCTime
fileNoteUpdatedAt :: !UTCTime
  } deriving (Int -> FileNote -> ShowS
[FileNote] -> ShowS
FileNote -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileNote] -> ShowS
$cshowList :: [FileNote] -> ShowS
show :: FileNote -> String
$cshow :: FileNote -> String
showsPrec :: Int -> FileNote -> ShowS
$cshowsPrec :: Int -> FileNote -> ShowS
Show, FileNote -> FileNote -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileNote -> FileNote -> Bool
$c/= :: FileNote -> FileNote -> Bool
== :: FileNote -> FileNote -> Bool
$c== :: FileNote -> FileNote -> Bool
Eq, Typeable, Eq FileNote
FileNote -> FileNote -> Bool
FileNote -> FileNote -> Ordering
FileNote -> FileNote -> FileNote
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileNote -> FileNote -> FileNote
$cmin :: FileNote -> FileNote -> FileNote
max :: FileNote -> FileNote -> FileNote
$cmax :: FileNote -> FileNote -> FileNote
>= :: FileNote -> FileNote -> Bool
$c>= :: FileNote -> FileNote -> Bool
> :: FileNote -> FileNote -> Bool
$c> :: FileNote -> FileNote -> Bool
<= :: FileNote -> FileNote -> Bool
$c<= :: FileNote -> FileNote -> Bool
< :: FileNote -> FileNote -> Bool
$c< :: FileNote -> FileNote -> Bool
compare :: FileNote -> FileNote -> Ordering
$ccompare :: FileNote -> FileNote -> Ordering
Ord)

instance FromJSON FileNote where
  parseJSON :: Value -> Parser FileNote
parseJSON (Object Object
o) =
    Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> FileNote
FileNote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"length" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (forall (m :: * -> *). MonadFail m => String -> m UTCTime
readFileNoteTime forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (forall (m :: * -> *). MonadFail m => String -> m UTCTime
readFileNoteTime forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at")
  parseJSON Value
_ = forall a. String -> Parser a
A.parseFail String
"bad parse"

instance ToJSON FileNote where
  toJSON :: FileNote -> Value
toJSON FileNote {Int
UTCTime
Text
fileNoteUpdatedAt :: UTCTime
fileNoteCreatedAt :: UTCTime
fileNoteLength :: Int
fileNoteText :: Text
fileNoteTitle :: Text
fileNoteId :: Text
fileNoteUpdatedAt :: FileNote -> UTCTime
fileNoteCreatedAt :: FileNote -> UTCTime
fileNoteLength :: FileNote -> Int
fileNoteText :: FileNote -> Text
fileNoteTitle :: FileNote -> Text
fileNoteId :: FileNote -> Text
..} =
    [Pair] -> Value
object
      [ Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Text
fileNoteId
      , Key
"title" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Text
fileNoteTitle
      , Key
"text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Text
fileNoteText
      , Key
"length" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Int
fileNoteLength
      , Key
"created_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON (UTCTime -> String
showFileNoteTime UTCTime
fileNoteCreatedAt)
      , Key
"updated_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON (UTCTime -> String
showFileNoteTime UTCTime
fileNoteUpdatedAt)
      ]

readFileNoteTime
  :: MonadFail m
  => String -> m UTCTime
readFileNoteTime :: forall (m :: * -> *). MonadFail m => String -> m UTCTime
readFileNoteTime = forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%F %T"

showFileNoteTime :: UTCTime -> String
showFileNoteTime :: UTCTime -> String
showFileNoteTime = forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %T"