{-# 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
  name Text
  passwordHash BCrypt
  apiToken HashedApiKey Maybe
  privateDefault Bool
  archiveDefault Bool
  privacyLock Bool
  UniqueUserName name
  deriving Show Eq Typeable Ord

Bookmark json
  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
  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
  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
(UTCTimeStr -> UTCTimeStr -> Bool)
-> (UTCTimeStr -> UTCTimeStr -> Bool) -> Eq UTCTimeStr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UTCTimeStr -> UTCTimeStr -> Bool
== :: UTCTimeStr -> UTCTimeStr -> Bool
$c/= :: UTCTimeStr -> UTCTimeStr -> Bool
/= :: UTCTimeStr -> UTCTimeStr -> Bool
Eq, Int -> UTCTimeStr -> ShowS
[UTCTimeStr] -> ShowS
UTCTimeStr -> String
(Int -> UTCTimeStr -> ShowS)
-> (UTCTimeStr -> String)
-> ([UTCTimeStr] -> ShowS)
-> Show UTCTimeStr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UTCTimeStr -> ShowS
showsPrec :: Int -> UTCTimeStr -> ShowS
$cshow :: UTCTimeStr -> String
show :: UTCTimeStr -> String
$cshowList :: [UTCTimeStr] -> ShowS
showList :: [UTCTimeStr] -> ShowS
Show, ReadPrec [UTCTimeStr]
ReadPrec UTCTimeStr
Int -> ReadS UTCTimeStr
ReadS [UTCTimeStr]
(Int -> ReadS UTCTimeStr)
-> ReadS [UTCTimeStr]
-> ReadPrec UTCTimeStr
-> ReadPrec [UTCTimeStr]
-> Read UTCTimeStr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UTCTimeStr
readsPrec :: Int -> ReadS UTCTimeStr
$creadList :: ReadS [UTCTimeStr]
readList :: ReadS [UTCTimeStr]
$creadPrec :: ReadPrec UTCTimeStr
readPrec :: ReadPrec UTCTimeStr
$creadListPrec :: ReadPrec [UTCTimeStr]
readListPrec :: ReadPrec [UTCTimeStr]
Read, (forall x. UTCTimeStr -> Rep UTCTimeStr x)
-> (forall x. Rep UTCTimeStr x -> UTCTimeStr) -> Generic UTCTimeStr
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
$cfrom :: forall x. UTCTimeStr -> Rep UTCTimeStr x
from :: forall x. UTCTimeStr -> Rep UTCTimeStr x
$cto :: forall x. Rep UTCTimeStr x -> UTCTimeStr
to :: forall x. Rep UTCTimeStr x -> UTCTimeStr
Generic, Maybe UTCTimeStr
Value -> Parser [UTCTimeStr]
Value -> Parser UTCTimeStr
(Value -> Parser UTCTimeStr)
-> (Value -> Parser [UTCTimeStr])
-> Maybe UTCTimeStr
-> FromJSON UTCTimeStr
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser UTCTimeStr
parseJSON :: Value -> Parser UTCTimeStr
$cparseJSONList :: Value -> Parser [UTCTimeStr]
parseJSONList :: Value -> Parser [UTCTimeStr]
$comittedField :: Maybe UTCTimeStr
omittedField :: Maybe UTCTimeStr
FromJSON, [UTCTimeStr] -> Value
[UTCTimeStr] -> Encoding
UTCTimeStr -> Bool
UTCTimeStr -> Value
UTCTimeStr -> Encoding
(UTCTimeStr -> Value)
-> (UTCTimeStr -> Encoding)
-> ([UTCTimeStr] -> Value)
-> ([UTCTimeStr] -> Encoding)
-> (UTCTimeStr -> Bool)
-> ToJSON UTCTimeStr
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: UTCTimeStr -> Value
toJSON :: UTCTimeStr -> Value
$ctoEncoding :: UTCTimeStr -> Encoding
toEncoding :: UTCTimeStr -> Encoding
$ctoJSONList :: [UTCTimeStr] -> Value
toJSONList :: [UTCTimeStr] -> Value
$ctoEncodingList :: [UTCTimeStr] -> Encoding
toEncodingList :: [UTCTimeStr] -> Encoding
$comitField :: UTCTimeStr -> Bool
omitField :: UTCTimeStr -> Bool
ToJSON)

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

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

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

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

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

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

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

type Limit = Int64
type Page = Int64

migrateAll :: Migration
migrateAll :: Migration
migrateAll = Migration
migrateSchema Migration -> Migration -> Migration
forall a b.
WriterT
  [Text] (WriterT CautiousMigration (ReaderT SqlBackend IO)) a
-> WriterT
     [Text] (WriterT CautiousMigration (ReaderT SqlBackend IO)) b
-> WriterT
     [Text] (WriterT CautiousMigration (ReaderT SqlBackend IO)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Migration
migrateIndexes

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

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

toMigration :: [Text] -> Migration
toMigration :: [Text] -> Migration
toMigration = WriterT CautiousMigration (ReaderT SqlBackend IO) () -> Migration
forall (m :: * -> *) a. Monad m => m a -> WriterT [Text] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT CautiousMigration (ReaderT SqlBackend IO) () -> Migration)
-> ([Text] -> WriterT CautiousMigration (ReaderT SqlBackend IO) ())
-> [Text]
-> Migration
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CautiousMigration
-> WriterT CautiousMigration (ReaderT SqlBackend IO) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (CautiousMigration
 -> WriterT CautiousMigration (ReaderT SqlBackend IO) ())
-> ([Text] -> CautiousMigration)
-> [Text]
-> WriterT CautiousMigration (ReaderT SqlBackend IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> (Bool, Text)) -> [Text] -> CautiousMigration
forall a b. (a -> b) -> [a] -> [b]
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 = Builder -> [SqlExpr (Value a)] -> SqlExpr (Value Text)
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
  Unique User -> SqlPersistT m (Maybe (Entity User))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Unique record -> ReaderT SqlBackend m (Maybe (Entity record))
getBy (Text -> Unique User
UniqueUserName Text
username) SqlPersistT m (Maybe (Entity User))
-> (Maybe (Entity User) -> SqlPersistT m (Maybe (Entity User)))
-> SqlPersistT m (Maybe (Entity User))
forall a b.
ReaderT SqlBackend m a
-> (a -> ReaderT SqlBackend m b) -> ReaderT SqlBackend m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Entity User)
Nothing -> Maybe (Entity User) -> SqlPersistT m (Maybe (Entity User))
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Entity User)
forall a. Maybe a
Nothing
    Just Entity User
dbuser ->
      if BCrypt -> Text -> Bool
validatePasswordHash (User -> BCrypt
userPasswordHash (Entity User -> User
forall record. Entity record -> record
entityVal Entity User
dbuser)) Text
password
        then Maybe (Entity User) -> SqlPersistT m (Maybe (Entity User))
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Entity User -> Maybe (Entity User)
forall a. a -> Maybe a
Just Entity User
dbuser)
        else Maybe (Entity User) -> SqlPersistT m (Maybe (Entity User))
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Entity User)
forall a. Maybe a
Nothing

getUserByName :: UserNameP -> DB (Maybe (Entity User))
getUserByName :: UserNameP -> DB (Maybe (Entity User))
getUserByName (UserNameP Text
uname) =
  [Filter User]
-> [SelectOpt User] -> ReaderT SqlBackend m (Maybe (Entity User))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlBackend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT SqlBackend m (Maybe (Entity record))
selectFirst [EntityField User Text
forall typ. (typ ~ Text) => EntityField User typ
UserName EntityField User Text -> Text -> Filter User
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 =
  [Filter User]
-> [SelectOpt User] -> ReaderT SqlBackend m (Maybe (Entity User))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlBackend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT SqlBackend m (Maybe (Entity record))
selectFirst [EntityField User (Maybe HashedApiKey)
forall typ. (typ ~ Maybe HashedApiKey) => EntityField User typ
UserApiToken EntityField User (Maybe HashedApiKey)
-> Maybe HashedApiKey -> Filter User
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. HashedApiKey -> Maybe HashedApiKey
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
-> Limit
-> Limit
-> DB (Int, [(Entity Bookmark, Maybe Text)])
bookmarksTagsQuery Key User
userId SharedP
sharedp FilterP
filterp [Text]
tags Maybe Text
mquery Limit
limit' Limit
page =
  (,) -- total count
  (Int
 -> [(Entity Bookmark, Maybe Text)]
 -> (Int, [(Entity Bookmark, Maybe Text)]))
-> ReaderT SqlBackend m Int
-> ReaderT
     SqlBackend
     m
     ([(Entity Bookmark, Maybe Text)]
      -> (Int, [(Entity Bookmark, Maybe Text)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Value Int] -> Int)
-> ReaderT SqlBackend m [Value Int] -> ReaderT SqlBackend m Int
forall a b.
(a -> b) -> ReaderT SqlBackend m a -> ReaderT SqlBackend m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Int] -> Int
[Int] -> Element [Int]
forall mono.
(MonoFoldable mono, Num (Element mono)) =>
mono -> Element mono
sum ([Int] -> Int) -> ([Value Int] -> [Int]) -> [Value Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Value Int -> Int) -> [Value Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value Int -> Int
forall a. Value a -> a
unValue)
      (SqlQuery (SqlExpr (Value Int)) -> ReaderT SqlBackend m [Value Int]
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select (SqlQuery (SqlExpr (Value Int))
 -> ReaderT SqlBackend m [Value Int])
-> SqlQuery (SqlExpr (Value Int))
-> ReaderT SqlBackend m [Value Int]
forall a b. (a -> b) -> a -> b
$ From (SqlExpr (Entity Bookmark))
-> SqlQuery (SqlExpr (Entity Bookmark))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @Bookmark) SqlQuery (SqlExpr (Entity Bookmark))
-> (SqlExpr (Entity Bookmark) -> SqlQuery (SqlExpr (Value Int)))
-> SqlQuery (SqlExpr (Value Int))
forall a b. SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
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 (Value Int) -> SqlQuery (SqlExpr (Value Int))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlExpr (Value Int)
forall a. Num a => SqlExpr (Value a)
countRows)
      -- paged data
  ReaderT
  SqlBackend
  m
  ([(Entity Bookmark, Maybe Text)]
   -> (Int, [(Entity Bookmark, Maybe Text)]))
-> ReaderT SqlBackend m [(Entity Bookmark, Maybe Text)]
-> ReaderT SqlBackend m (Int, [(Entity Bookmark, Maybe Text)])
forall a b.
ReaderT SqlBackend m (a -> b)
-> ReaderT SqlBackend m a -> ReaderT SqlBackend m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([(Entity Bookmark, Value (Maybe Text))]
 -> [(Entity Bookmark, Maybe Text)])
-> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))]
-> ReaderT SqlBackend m [(Entity Bookmark, Maybe Text)]
forall a b.
(a -> b) -> ReaderT SqlBackend m a -> ReaderT SqlBackend m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(Entity Bookmark, Value (Maybe Text))]
  -> [(Entity Bookmark, Maybe Text)])
 -> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))]
 -> ReaderT SqlBackend m [(Entity Bookmark, Maybe Text)])
-> ((Value (Maybe Text) -> Maybe Text)
    -> [(Entity Bookmark, Value (Maybe Text))]
    -> [(Entity Bookmark, Maybe Text)])
-> (Value (Maybe Text) -> Maybe Text)
-> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))]
-> ReaderT SqlBackend m [(Entity Bookmark, Maybe Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Entity Bookmark, Value (Maybe Text))
 -> (Entity Bookmark, Maybe Text))
-> [(Entity Bookmark, Value (Maybe Text))]
-> [(Entity Bookmark, Maybe Text)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Entity Bookmark, Value (Maybe Text))
  -> (Entity Bookmark, Maybe Text))
 -> [(Entity Bookmark, Value (Maybe Text))]
 -> [(Entity Bookmark, Maybe Text)])
-> ((Value (Maybe Text) -> Maybe Text)
    -> (Entity Bookmark, Value (Maybe Text))
    -> (Entity Bookmark, Maybe Text))
-> (Value (Maybe Text) -> Maybe Text)
-> [(Entity Bookmark, Value (Maybe Text))]
-> [(Entity Bookmark, Maybe Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Value (Maybe Text) -> Maybe Text)
-> (Entity Bookmark, Value (Maybe Text))
-> (Entity Bookmark, Maybe Text)
forall a b.
(a -> b) -> (Entity Bookmark, a) -> (Entity Bookmark, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Value (Maybe Text) -> Maybe Text
forall a. Value a -> a
unValue
      (SqlQuery (SqlExpr (Entity Bookmark), SqlExpr (Value (Maybe Text)))
-> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))]
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select (SqlQuery (SqlExpr (Entity Bookmark), SqlExpr (Value (Maybe Text)))
 -> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))])
-> SqlQuery
     (SqlExpr (Entity Bookmark), SqlExpr (Value (Maybe Text)))
-> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))]
forall a b. (a -> b) -> a -> b
$ From (SqlExpr (Entity Bookmark))
-> SqlQuery (SqlExpr (Entity Bookmark))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @Bookmark) SqlQuery (SqlExpr (Entity Bookmark))
-> (SqlExpr (Entity Bookmark)
    -> SqlQuery
         (SqlExpr (Entity Bookmark), SqlExpr (Value (Maybe Text))))
-> SqlQuery
     (SqlExpr (Entity Bookmark), SqlExpr (Value (Maybe Text)))
forall a b. SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
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 [SqlExpr (Value UTCTime) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
desc (SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark UTCTime -> SqlExpr (Value UTCTime)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark UTCTime
forall typ. (typ ~ UTCTime) => EntityField Bookmark typ
BookmarkTime)]
       Limit -> SqlQuery ()
limit Limit
limit'
       Limit -> SqlQuery ()
offset ((Limit
page Limit -> Limit -> Limit
forall a. Num a => a -> a -> a
- Limit
1) Limit -> Limit -> Limit
forall a. Num a => a -> a -> a
* Limit
limit')
       (SqlExpr (Entity Bookmark), SqlExpr (Value (Maybe Text)))
-> SqlQuery
     (SqlExpr (Entity Bookmark), SqlExpr (Value (Maybe Text)))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity Bookmark)
b, SqlQuery (SqlExpr (Value Text)) -> SqlExpr (Value (Maybe Text))
forall a.
PersistField a =>
SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value (Maybe a))
subSelect (SqlQuery (SqlExpr (Value Text)) -> SqlExpr (Value (Maybe Text)))
-> SqlQuery (SqlExpr (Value Text)) -> SqlExpr (Value (Maybe Text))
forall a b. (a -> b) -> a -> b
$ From (SqlExpr (Entity BookmarkTag))
-> SqlQuery (SqlExpr (Entity BookmarkTag))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag) SqlQuery (SqlExpr (Entity BookmarkTag))
-> (SqlExpr (Entity BookmarkTag)
    -> SqlQuery (SqlExpr (Value Text)))
-> SqlQuery (SqlExpr (Value Text))
forall a b. SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
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 SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId SqlExpr (Value (Key Bookmark))
-> SqlExpr (Value (Key Bookmark)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId)
                SqlExpr (Value (Key Bookmark)) -> SqlQuery ()
forall a. ToSomeValues a => a -> SqlQuery ()
groupBy (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId)
                [SqlExpr OrderBy] -> SqlQuery ()
orderBy [SqlExpr (Value Int) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
asc (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Int -> SqlExpr (Value Int)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Int
forall typ. (typ ~ Int) => EntityField BookmarkTag typ
BookmarkTagSeq)]
                SqlExpr (Value Text) -> SqlQuery (SqlExpr (Value Text))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Value Text) -> SqlQuery (SqlExpr (Value Text)))
-> SqlExpr (Value Text) -> SqlQuery (SqlExpr (Value Text))
forall a b. (a -> b) -> a -> b
$ SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Text)
forall a.
PersistField a =>
SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Text)
sqliteGroupConcat (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag) (Text -> SqlExpr (Value Text)
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_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$
        (SqlExpr (Value Bool) -> Text -> SqlExpr (Value Bool))
-> SqlExpr (Value Bool) -> [Text] -> SqlExpr (Value Bool)
forall b a. (b -> a -> b) -> 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
                          From (SqlExpr (Entity BookmarkTag))
-> SqlQuery (SqlExpr (Entity BookmarkTag))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag) SqlQuery (SqlExpr (Entity BookmarkTag))
-> (SqlExpr (Entity BookmarkTag) -> SqlQuery ()) -> SqlQuery ()
forall a b. SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
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 SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId SqlExpr (Value (Key Bookmark))
-> SqlExpr (Value (Key Bookmark)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&.
                                 (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
`like` Text -> SqlExpr (Value Text)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Text
tag))))
          (SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark (Key User) -> SqlExpr (Value (Key User))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark (Key User)
forall typ. (typ ~ Key User) => EntityField Bookmark typ
BookmarkUserId SqlExpr (Value (Key User))
-> SqlExpr (Value (Key User)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Key User -> SqlExpr (Value (Key User))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key User
userId)
          [Text]
tags
      case SharedP
sharedp of
        SharedP
SharedAll -> () -> SqlQuery ()
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        SharedP
SharedPublic ->  SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark Bool -> SqlExpr (Value Bool)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark Bool
forall typ. (typ ~ Bool) => EntityField Bookmark typ
BookmarkShared SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Bool -> 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 SqlExpr (Entity Bookmark)
-> EntityField Bookmark Bool -> SqlExpr (Value Bool)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark Bool
forall typ. (typ ~ Bool) => EntityField Bookmark typ
BookmarkShared SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Bool -> SqlExpr (Value Bool)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Bool
False)
      case FilterP
filterp of
        FilterP
FilterAll -> () -> SqlQuery ()
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        FilterP
FilterUnread -> SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark Bool -> SqlExpr (Value Bool)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark Bool
forall typ. (typ ~ Bool) => EntityField Bookmark typ
BookmarkToRead SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Bool -> 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 SqlExpr (Entity Bookmark)
-> EntityField Bookmark Bool -> SqlExpr (Value Bool)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark Bool
forall typ. (typ ~ Bool) => EntityField Bookmark typ
BookmarkSelected SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Bool -> 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 SqlExpr (Entity Bookmark)
-> EntityField Bookmark BmSlug -> SqlExpr (Value BmSlug)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark BmSlug
forall typ. (typ ~ BmSlug) => EntityField Bookmark typ
BookmarkSlug SqlExpr (Value BmSlug)
-> SqlExpr (Value BmSlug) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. BmSlug -> SqlExpr (Value BmSlug)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val BmSlug
slug)
        FilterP
FilterUntagged -> SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SqlQuery () -> SqlExpr (Value Bool)
notExists (SqlQuery () -> SqlExpr (Value Bool))
-> SqlQuery () -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ From (SqlExpr (Entity BookmarkTag))
-> SqlQuery (SqlExpr (Entity BookmarkTag))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag) SqlQuery (SqlExpr (Entity BookmarkTag))
-> (SqlExpr (Entity BookmarkTag) -> SqlQuery ()) -> SqlQuery ()
forall a b. SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SqlExpr (Entity BookmarkTag)
t -> SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$
                                                    SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId SqlExpr (Value (Key Bookmark))
-> SqlExpr (Value (Key Bookmark)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId
      -- search
      Maybe (SqlQuery ()) -> SqlQuery ()
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) (Text -> Maybe (SqlQuery ())) -> Maybe Text -> Maybe (SqlQuery ())
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 = SqlExpr (Value Bool)
-> Either String (SqlExpr (Value Bool)) -> SqlExpr (Value Bool)
forall b a. b -> Either a b -> b
fromRight SqlExpr (Value Bool)
p_allFields (Parser (SqlExpr (Value Bool))
-> Text -> Either String (SqlExpr (Value Bool))
forall a. Parser a -> Text -> Either String a
P.parseOnly Parser (SqlExpr (Value Bool))
p_onefield Text
term)
      where
        wild :: s -> SqlExpr (Value s)
wild s
s = SqlExpr (Value s)
forall s. SqlString s => SqlExpr (Value s)
(%) SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
++. s -> SqlExpr (Value s)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val s
s SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
forall s.
SqlString s =>
SqlExpr (Value 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 SqlExpr (Entity Bookmark)
-> EntityField Bookmark Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark Text
field SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
`like` Text -> SqlExpr (Value Text)
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 EntityField Bookmark Text
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 EntityField Bookmark Text
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 EntityField Bookmark Text
forall typ. (typ ~ Text) => EntityField Bookmark typ
BookmarkExtended Text
term SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
||.
          SqlQuery () -> SqlExpr (Value Bool)
exists (From (SqlExpr (Entity BookmarkTag))
-> SqlQuery (SqlExpr (Entity BookmarkTag))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag) SqlQuery (SqlExpr (Entity BookmarkTag))
-> (SqlExpr (Entity BookmarkTag) -> SqlQuery ()) -> SqlQuery ()
forall a b. SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SqlExpr (Entity BookmarkTag)
t -> SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$
               (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId SqlExpr (Value (Key Bookmark))
-> SqlExpr (Value (Key Bookmark)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId) SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&.
               (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
`like` Text -> SqlExpr (Value Text)
forall {s}. SqlString s => s -> SqlExpr (Value s)
wild Text
term))
        p_onefield :: Parser (SqlExpr (Value Bool))
p_onefield = Parser (SqlExpr (Value Bool))
p_url Parser (SqlExpr (Value Bool))
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (SqlExpr (Value Bool))
p_title Parser (SqlExpr (Value Bool))
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (SqlExpr (Value Bool))
p_description Parser (SqlExpr (Value Bool))
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (SqlExpr (Value Bool))
p_tags Parser (SqlExpr (Value Bool))
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (SqlExpr (Value Bool))
p_after Parser (SqlExpr (Value Bool))
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (SqlExpr (Value Bool))
p_before
          where
            p_url :: Parser (SqlExpr (Value Bool))
p_url = Parser Text Text
"url:" Parser Text Text
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> SqlExpr (Value Bool))
-> Parser Text Text -> Parser (SqlExpr (Value Bool))
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EntityField Bookmark Text -> Text -> SqlExpr (Value Bool)
toLikeB EntityField Bookmark Text
forall typ. (typ ~ Text) => EntityField Bookmark typ
BookmarkHref) Parser Text Text
P.takeText
            p_title :: Parser (SqlExpr (Value Bool))
p_title = Parser Text Text
"title:" Parser Text Text
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> SqlExpr (Value Bool))
-> Parser Text Text -> Parser (SqlExpr (Value Bool))
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EntityField Bookmark Text -> Text -> SqlExpr (Value Bool)
toLikeB EntityField Bookmark Text
forall typ. (typ ~ Text) => EntityField Bookmark typ
BookmarkDescription) Parser Text Text
P.takeText
            p_description :: Parser (SqlExpr (Value Bool))
p_description = Parser Text Text
"description:" Parser Text Text
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> SqlExpr (Value Bool))
-> Parser Text Text -> Parser (SqlExpr (Value Bool))
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EntityField Bookmark Text -> Text -> SqlExpr (Value Bool)
toLikeB EntityField Bookmark Text
forall typ. (typ ~ Text) => EntityField Bookmark typ
BookmarkExtended) Parser Text Text
P.takeText
            p_tags :: Parser (SqlExpr (Value Bool))
p_tags = Parser Text Text
"tags:" Parser Text Text
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> SqlExpr (Value Bool))
-> Parser Text Text -> Parser (SqlExpr (Value Bool))
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
term' -> SqlQuery () -> SqlExpr (Value Bool)
exists (SqlQuery () -> SqlExpr (Value Bool))
-> SqlQuery () -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ From (SqlExpr (Entity BookmarkTag))
-> SqlQuery (SqlExpr (Entity BookmarkTag))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag) SqlQuery (SqlExpr (Entity BookmarkTag))
-> (SqlExpr (Entity BookmarkTag) -> SqlQuery ()) -> SqlQuery ()
forall a b. SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SqlExpr (Entity BookmarkTag)
t -> SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$
                                                         (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId SqlExpr (Value (Key Bookmark))
-> SqlExpr (Value (Key Bookmark)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId) SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&.
                                                         (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
`like` Text -> SqlExpr (Value Text)
forall {s}. SqlString s => s -> SqlExpr (Value s)
wild Text
term')) Parser Text Text
P.takeText
            p_after :: Parser (SqlExpr (Value Bool))
p_after  = Parser Text Text
"after:"  Parser Text Text
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (UTCTime -> SqlExpr (Value Bool))
-> Parser Text UTCTime -> Parser (SqlExpr (Value Bool))
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark UTCTime -> SqlExpr (Value UTCTime)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark UTCTime
forall typ. (typ ~ UTCTime) => EntityField Bookmark typ
BookmarkTime SqlExpr (Value UTCTime)
-> SqlExpr (Value UTCTime) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
>=.) (SqlExpr (Value UTCTime) -> SqlExpr (Value Bool))
-> (UTCTime -> SqlExpr (Value UTCTime))
-> UTCTime
-> SqlExpr (Value Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTCTime -> SqlExpr (Value UTCTime)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val) (Text -> Parser Text UTCTime
forall t (m :: * -> *).
(ParseTime t, MonadFail m, Alternative m) =>
Text -> m t
parseTimeText (Text -> Parser Text UTCTime)
-> Parser Text Text -> Parser Text UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Text Text
P.takeText)
            p_before :: Parser (SqlExpr (Value Bool))
p_before = Parser Text Text
"before:" Parser Text Text
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (UTCTime -> SqlExpr (Value Bool))
-> Parser Text UTCTime -> Parser (SqlExpr (Value Bool))
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark UTCTime -> SqlExpr (Value UTCTime)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark UTCTime
forall typ. (typ ~ UTCTime) => EntityField Bookmark typ
BookmarkTime SqlExpr (Value UTCTime)
-> SqlExpr (Value UTCTime) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
<=.) (SqlExpr (Value UTCTime) -> SqlExpr (Value Bool))
-> (UTCTime -> SqlExpr (Value UTCTime))
-> UTCTime
-> SqlExpr (Value Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTCTime -> SqlExpr (Value UTCTime)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val) (Text -> Parser Text UTCTime
forall t (m :: * -> *).
(ParseTime t, MonadFail m, Alternative m) =>
Text -> m t
parseTimeText (Text -> Parser Text UTCTime)
-> Parser Text Text -> Parser Text UTCTime
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 =
  (([(Entity Bookmark, Value (Maybe Text))]
 -> [(Entity Bookmark, Text)])
-> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))]
-> SqlPersistT m [(Entity Bookmark, Text)]
forall a b.
(a -> b) -> ReaderT SqlBackend m a -> ReaderT SqlBackend m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(Entity Bookmark, Value (Maybe Text))]
  -> [(Entity Bookmark, Text)])
 -> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))]
 -> SqlPersistT m [(Entity Bookmark, Text)])
-> ((Value (Maybe Text) -> Text)
    -> [(Entity Bookmark, Value (Maybe Text))]
    -> [(Entity Bookmark, Text)])
-> (Value (Maybe Text) -> Text)
-> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))]
-> SqlPersistT m [(Entity Bookmark, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Entity Bookmark, Value (Maybe Text)) -> (Entity Bookmark, Text))
-> [(Entity Bookmark, Value (Maybe Text))]
-> [(Entity Bookmark, Text)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Entity Bookmark, Value (Maybe Text)) -> (Entity Bookmark, Text))
 -> [(Entity Bookmark, Value (Maybe Text))]
 -> [(Entity Bookmark, Text)])
-> ((Value (Maybe Text) -> Text)
    -> (Entity Bookmark, Value (Maybe Text))
    -> (Entity Bookmark, Text))
-> (Value (Maybe Text) -> Text)
-> [(Entity Bookmark, Value (Maybe Text))]
-> [(Entity Bookmark, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Value (Maybe Text) -> Text)
-> (Entity Bookmark, Value (Maybe Text)) -> (Entity Bookmark, Text)
forall a b.
(a -> b) -> (Entity Bookmark, a) -> (Entity Bookmark, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text)
-> (Value (Maybe Text) -> Maybe Text) -> Value (Maybe Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Value (Maybe Text) -> Maybe Text
forall a. Value a -> a
unValue) (ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))]
 -> SqlPersistT m [(Entity Bookmark, Text)])
-> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))]
-> SqlPersistT m [(Entity Bookmark, Text)]
forall a b. (a -> b) -> a -> b
$
  SqlQuery (SqlExpr (Entity Bookmark), SqlExpr (Value (Maybe Text)))
-> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))]
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select (SqlQuery (SqlExpr (Entity Bookmark), SqlExpr (Value (Maybe Text)))
 -> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))])
-> SqlQuery
     (SqlExpr (Entity Bookmark), SqlExpr (Value (Maybe Text)))
-> ReaderT SqlBackend m [(Entity Bookmark, Value (Maybe Text))]
forall a b. (a -> b) -> a -> b
$ do
    SqlExpr (Entity Bookmark)
b <- From (SqlExpr (Entity Bookmark))
-> SqlQuery (SqlExpr (Entity Bookmark))
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 SqlExpr (Entity Bookmark)
-> EntityField Bookmark (Key User) -> SqlExpr (Value (Key User))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark (Key User)
forall typ. (typ ~ Key User) => EntityField Bookmark typ
BookmarkUserId SqlExpr (Value (Key User))
-> SqlExpr (Value (Key User)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Key User -> SqlExpr (Value (Key User))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key User
user)
    [SqlExpr OrderBy] -> SqlQuery ()
orderBy [SqlExpr (Value UTCTime) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
asc (SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark UTCTime -> SqlExpr (Value UTCTime)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark UTCTime
forall typ. (typ ~ UTCTime) => EntityField Bookmark typ
BookmarkTime)]
    (SqlExpr (Entity Bookmark), SqlExpr (Value (Maybe Text)))
-> SqlQuery
     (SqlExpr (Entity Bookmark), SqlExpr (Value (Maybe Text)))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity Bookmark)
b, SqlQuery (SqlExpr (Value Text)) -> SqlExpr (Value (Maybe Text))
forall a.
PersistField a =>
SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value (Maybe a))
subSelect (SqlQuery (SqlExpr (Value Text)) -> SqlExpr (Value (Maybe Text)))
-> SqlQuery (SqlExpr (Value Text)) -> SqlExpr (Value (Maybe Text))
forall a b. (a -> b) -> a -> b
$ From (SqlExpr (Entity BookmarkTag))
-> SqlQuery (SqlExpr (Entity BookmarkTag))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @BookmarkTag) SqlQuery (SqlExpr (Entity BookmarkTag))
-> (SqlExpr (Entity BookmarkTag)
    -> SqlQuery (SqlExpr (Value Text)))
-> SqlQuery (SqlExpr (Value Text))
forall a b. SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
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 SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId SqlExpr (Value (Key Bookmark))
-> SqlExpr (Value (Key Bookmark)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity Bookmark)
b SqlExpr (Entity Bookmark)
-> EntityField Bookmark (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Bookmark (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId)
             SqlExpr (Value (Key Bookmark)) -> SqlQuery ()
forall a. ToSomeValues a => a -> SqlQuery ()
groupBy (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId)
             [SqlExpr OrderBy] -> SqlQuery ()
orderBy [SqlExpr (Value Int) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
asc (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Int -> SqlExpr (Value Int)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Int
forall typ. (typ ~ Int) => EntityField BookmarkTag typ
BookmarkTagSeq)]
             SqlExpr (Value Text) -> SqlQuery (SqlExpr (Value Text))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Value Text) -> SqlQuery (SqlExpr (Value Text)))
-> SqlExpr (Value Text) -> SqlQuery (SqlExpr (Value Text))
forall a b. (a -> b) -> a -> b
$ SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Text)
forall a.
PersistField a =>
SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Text)
sqliteGroupConcat (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag) (Text -> SqlExpr (Value Text)
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 =
  (SqlExpr (Value Bool) -> SqlQuery ())
-> Maybe (SqlExpr (Value Bool)) -> Maybe (SqlQuery ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SqlExpr (Value Bool) -> SqlQuery ()
where_ (Maybe (SqlExpr (Value Bool)) -> Maybe (SqlQuery ()))
-> (Text -> Maybe (SqlExpr (Value Bool)))
-> Text
-> Maybe (SqlQuery ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String -> Maybe (SqlExpr (Value Bool)))
-> (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool)))
-> Either String (SqlExpr (Value Bool))
-> Maybe (SqlExpr (Value Bool))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (SqlExpr (Value Bool))
-> String -> Maybe (SqlExpr (Value Bool))
forall a b. a -> b -> a
const Maybe (SqlExpr (Value Bool))
forall a. Maybe a
Nothing) SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a. a -> Maybe a
Just (Either String (SqlExpr (Value Bool))
 -> Maybe (SqlExpr (Value Bool)))
-> (Text -> Either String (SqlExpr (Value Bool)))
-> Text
-> Maybe (SqlExpr (Value Bool))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parser (SqlExpr (Value Bool))
-> Text -> Either String (SqlExpr (Value Bool))
forall a. Parser a -> Text -> Either String a
P.parseOnly Parser (SqlExpr (Value Bool))
andE
  where
    andE :: Parser (SqlExpr (Value Bool))
andE = (SqlExpr (Value Bool)
 -> SqlExpr (Value Bool) -> SqlExpr (Value Bool))
-> [SqlExpr (Value Bool)] -> SqlExpr (Value Bool)
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
(&&.) ([SqlExpr (Value Bool)] -> SqlExpr (Value Bool))
-> Parser Text [SqlExpr (Value Bool)]
-> Parser (SqlExpr (Value Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SqlExpr (Value Bool)) -> Parser Text [SqlExpr (Value Bool)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 (Parser ()
P.skipSpace Parser ()
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (SqlExpr (Value Bool))
orE Parser (SqlExpr (Value Bool))
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (SqlExpr (Value Bool))
tokenTermE)
    orE :: Parser (SqlExpr (Value Bool))
orE = (SqlExpr (Value Bool)
 -> SqlExpr (Value Bool) -> SqlExpr (Value Bool))
-> [SqlExpr (Value Bool)] -> SqlExpr (Value Bool)
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
(||.) ([SqlExpr (Value Bool)] -> SqlExpr (Value Bool))
-> Parser Text [SqlExpr (Value Bool)]
-> Parser (SqlExpr (Value Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SqlExpr (Value Bool))
tokenTermE Parser (SqlExpr (Value Bool))
-> Parser Text Char -> Parser Text [SqlExpr (Value Bool)]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`P.sepBy1` Char -> Parser Text Char
P.char Char
'|'
    tokenTermE :: Parser (SqlExpr (Value Bool))
tokenTermE = Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
negE Parser (SqlExpr (Value Bool))
termE Parser (SqlExpr (Value Bool))
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (SqlExpr (Value Bool))
termE
      where
        negE :: Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
negE Parser (SqlExpr (Value Bool))
p = SqlExpr (Value Bool) -> SqlExpr (Value Bool)
not_ (SqlExpr (Value Bool) -> SqlExpr (Value Bool))
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Text Char
P.char Char
'-' Parser Text Char
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (SqlExpr (Value Bool))
p)
        termE :: Parser (SqlExpr (Value Bool))
termE = Text -> SqlExpr (Value Bool)
toExpr (Text -> SqlExpr (Value Bool))
-> Parser Text Text -> Parser (SqlExpr (Value Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
fieldTerm Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
quotedTerm Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
simpleTerm)
        fieldTerm :: Parser Text Text
fieldTerm = [Text] -> Text
[Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat ([Text] -> Text) -> Parser Text [Text] -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Text Text] -> Parser Text [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Parser Text Text
simpleTerm, Text -> Parser Text Text
P.string Text
":", Parser Text Text
quotedTerm Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
simpleTerm]
        quotedTerm :: Parser Text Text
quotedTerm = Parser Text Char
-> Parser Text Char -> Parser Text Text -> Parser Text Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
PC.between (Char -> Parser Text Char
P.char Char
'"') (Char -> Parser Text Char
P.char Char
'"') ((Char -> Bool) -> Parser Text Text
P.takeWhile1 (Char -> Char -> Bool
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
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 =
  [m t] -> m t
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([m t] -> m t) -> [m t] -> m t
forall a b. (a -> b) -> a -> b
$
  (String -> String -> m t) -> String -> String -> m t
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> TimeLocale -> String -> String -> m t
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale) (Text -> [Element Text]
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack Text
t) (String -> m t) -> [String] -> [m 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 = [Filter BookmarkTag]
-> [SelectOpt BookmarkTag]
-> ReaderT SqlBackend m [Entity BookmarkTag]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField BookmarkTag (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId EntityField BookmarkTag (Key Bookmark)
-> Key Bookmark -> Filter BookmarkTag
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. Key Bookmark
key] [EntityField BookmarkTag Int -> SelectOpt BookmarkTag
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField BookmarkTag Int
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 =
  [Filter Note]
-> [SelectOpt Note] -> ReaderT SqlBackend m (Maybe (Entity Note))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlBackend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT SqlBackend m (Maybe (Entity record))
selectFirst [EntityField Note (Key User)
forall typ. (typ ~ Key User) => EntityField Note typ
NoteUserId EntityField Note (Key User) -> Key User -> Filter Note
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. Key User
userKey, EntityField Note NtSlug
forall typ. (typ ~ NtSlug) => EntityField Note typ
NoteSlug EntityField Note NtSlug -> NtSlug -> Filter Note
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
-> Limit
-> Limit
-> DB (Int, [Entity Note])
getNoteList Key User
key Maybe Text
mquery SharedP
sharedp Limit
limit' Limit
page =
  (,) -- total count
  (Int -> [Entity Note] -> (Int, [Entity Note]))
-> ReaderT SqlBackend m Int
-> ReaderT SqlBackend m ([Entity Note] -> (Int, [Entity Note]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Value Int] -> Int)
-> ReaderT SqlBackend m [Value Int] -> ReaderT SqlBackend m Int
forall a b.
(a -> b) -> ReaderT SqlBackend m a -> ReaderT SqlBackend m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Int] -> Int
[Int] -> Element [Int]
forall mono.
(MonoFoldable mono, Num (Element mono)) =>
mono -> Element mono
sum ([Int] -> Int) -> ([Value Int] -> [Int]) -> [Value Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Value Int -> Int) -> [Value Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value Int -> Int
forall a. Value a -> a
unValue)
      (SqlQuery (SqlExpr (Value Int)) -> ReaderT SqlBackend m [Value Int]
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select (SqlQuery (SqlExpr (Value Int))
 -> ReaderT SqlBackend m [Value Int])
-> SqlQuery (SqlExpr (Value Int))
-> ReaderT SqlBackend m [Value Int]
forall a b. (a -> b) -> a -> b
$ do
      SqlExpr (Entity Note)
b <- From (SqlExpr (Entity Note)) -> SqlQuery (SqlExpr (Entity Note))
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 (Value Int) -> SqlQuery (SqlExpr (Value Int))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlExpr (Value Int)
forall a. Num a => SqlExpr (Value a)
countRows)
  ReaderT SqlBackend m ([Entity Note] -> (Int, [Entity Note]))
-> ReaderT SqlBackend m [Entity Note]
-> ReaderT SqlBackend m (Int, [Entity Note])
forall a b.
ReaderT SqlBackend m (a -> b)
-> ReaderT SqlBackend m a -> ReaderT SqlBackend m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SqlQuery (SqlExpr (Entity Note))
-> ReaderT SqlBackend m [Entity Note]
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select (SqlQuery (SqlExpr (Entity Note))
 -> ReaderT SqlBackend m [Entity Note])
-> SqlQuery (SqlExpr (Entity Note))
-> ReaderT SqlBackend m [Entity Note]
forall a b. (a -> b) -> a -> b
$ do
       SqlExpr (Entity Note)
b <- From (SqlExpr (Entity Note)) -> SqlQuery (SqlExpr (Entity Note))
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 [SqlExpr (Value UTCTime) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
desc (SqlExpr (Entity Note)
b SqlExpr (Entity Note)
-> EntityField Note UTCTime -> SqlExpr (Value UTCTime)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Note UTCTime
forall typ. (typ ~ UTCTime) => EntityField Note typ
NoteCreated)]
       Limit -> SqlQuery ()
limit Limit
limit'
       Limit -> SqlQuery ()
offset ((Limit
page Limit -> Limit -> Limit
forall a. Num a => a -> a -> a
- Limit
1) Limit -> Limit -> Limit
forall a. Num a => a -> a -> a
* Limit
limit')
       SqlExpr (Entity Note) -> SqlQuery (SqlExpr (Entity Note))
forall a. a -> SqlQuery a
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 SqlExpr (Entity Note)
-> EntityField Note (Key User) -> SqlExpr (Value (Key User))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Note (Key User)
forall typ. (typ ~ Key User) => EntityField Note typ
NoteUserId SqlExpr (Value (Key User))
-> SqlExpr (Value (Key User)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Key User -> SqlExpr (Value (Key User))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key User
key)
      -- search
      Maybe (SqlQuery ()) -> SqlQuery ()
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) (Text -> Maybe (SqlQuery ())) -> Maybe Text -> Maybe (SqlQuery ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
mquery)
      case SharedP
sharedp of
        SharedP
SharedAll -> () -> SqlQuery ()
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        SharedP
SharedPublic ->  SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Note)
b SqlExpr (Entity Note)
-> EntityField Note Bool -> SqlExpr (Value Bool)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Note Bool
forall typ. (typ ~ Bool) => EntityField Note typ
NoteShared SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Bool -> 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 SqlExpr (Entity Note)
-> EntityField Note Bool -> SqlExpr (Value Bool)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Note Bool
forall typ. (typ ~ Bool) => EntityField Note typ
NoteShared SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Bool -> 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 = SqlExpr (Value Bool)
-> Either String (SqlExpr (Value Bool)) -> SqlExpr (Value Bool)
forall b a. b -> Either a b -> b
fromRight SqlExpr (Value Bool)
p_allFields (Parser (SqlExpr (Value Bool))
-> Text -> Either String (SqlExpr (Value Bool))
forall a. Parser a -> Text -> Either String a
P.parseOnly Parser (SqlExpr (Value Bool))
p_onefield Text
term)
      where
        wild :: s -> SqlExpr (Value s)
wild s
s = SqlExpr (Value s)
forall s. SqlString s => SqlExpr (Value s)
(%) SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
++. s -> SqlExpr (Value s)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val s
s SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
forall s.
SqlString s =>
SqlExpr (Value 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 SqlExpr (Entity Note)
-> EntityField Note Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Note Text
field SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
`like` Text -> SqlExpr (Value Text)
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 EntityField Note Text
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 EntityField Note Text
forall typ. (typ ~ Text) => EntityField Note typ
NoteText Text
term
        p_onefield :: Parser (SqlExpr (Value Bool))
p_onefield = Parser (SqlExpr (Value Bool))
p_title Parser (SqlExpr (Value Bool))
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (SqlExpr (Value Bool))
p_text Parser (SqlExpr (Value Bool))
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (SqlExpr (Value Bool))
p_after Parser (SqlExpr (Value Bool))
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (SqlExpr (Value Bool))
p_before
          where
            p_title :: Parser (SqlExpr (Value Bool))
p_title = Parser Text Text
"title:" Parser Text Text
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> SqlExpr (Value Bool))
-> Parser Text Text -> Parser (SqlExpr (Value Bool))
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EntityField Note Text -> Text -> SqlExpr (Value Bool)
toLikeN EntityField Note Text
forall typ. (typ ~ Text) => EntityField Note typ
NoteTitle) Parser Text Text
P.takeText
            p_text :: Parser (SqlExpr (Value Bool))
p_text = Parser Text Text
"description:" Parser Text Text
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> SqlExpr (Value Bool))
-> Parser Text Text -> Parser (SqlExpr (Value Bool))
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EntityField Note Text -> Text -> SqlExpr (Value Bool)
toLikeN EntityField Note Text
forall typ. (typ ~ Text) => EntityField Note typ
NoteText) Parser Text Text
P.takeText
            p_after :: Parser (SqlExpr (Value Bool))
p_after  = Parser Text Text
"after:"  Parser Text Text
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (UTCTime -> SqlExpr (Value Bool))
-> Parser Text UTCTime -> Parser (SqlExpr (Value Bool))
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SqlExpr (Entity Note)
b SqlExpr (Entity Note)
-> EntityField Note UTCTime -> SqlExpr (Value UTCTime)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Note UTCTime
forall typ. (typ ~ UTCTime) => EntityField Note typ
NoteCreated SqlExpr (Value UTCTime)
-> SqlExpr (Value UTCTime) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
>=.) (SqlExpr (Value UTCTime) -> SqlExpr (Value Bool))
-> (UTCTime -> SqlExpr (Value UTCTime))
-> UTCTime
-> SqlExpr (Value Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTCTime -> SqlExpr (Value UTCTime)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val) (Text -> Parser Text UTCTime
forall t (m :: * -> *).
(ParseTime t, MonadFail m, Alternative m) =>
Text -> m t
parseTimeText (Text -> Parser Text UTCTime)
-> Parser Text Text -> Parser Text UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Text Text
P.takeText)
            p_before :: Parser (SqlExpr (Value Bool))
p_before = Parser Text Text
"before:" Parser Text Text
-> Parser (SqlExpr (Value Bool)) -> Parser (SqlExpr (Value Bool))
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (UTCTime -> SqlExpr (Value Bool))
-> Parser Text UTCTime -> Parser (SqlExpr (Value Bool))
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SqlExpr (Entity Note)
b SqlExpr (Entity Note)
-> EntityField Note UTCTime -> SqlExpr (Value UTCTime)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField Note UTCTime
forall typ. (typ ~ UTCTime) => EntityField Note typ
NoteCreated SqlExpr (Value UTCTime)
-> SqlExpr (Value UTCTime) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
<=.) (SqlExpr (Value UTCTime) -> SqlExpr (Value Bool))
-> (UTCTime -> SqlExpr (Value UTCTime))
-> UTCTime
-> SqlExpr (Value Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTCTime -> SqlExpr (Value UTCTime)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val) (Text -> Parser Text UTCTime
forall t (m :: * -> *).
(ParseTime t, MonadFail m, Alternative m) =>
Text -> m t
parseTimeText (Text -> Parser Text UTCTime)
-> Parser Text Text -> Parser Text UTCTime
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) ((Int, Text) -> BookmarkTag) -> [(Int, Text)] -> [BookmarkTag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, 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
Text
UTCTime
fileBookmarkHref :: Text
fileBookmarkDescription :: Text
fileBookmarkExtended :: Text
fileBookmarkTime :: UTCTime
fileBookmarkShared :: Bool
fileBookmarkToRead :: Bool
fileBookmarkSelected :: Maybe Bool
fileBookmarkArchiveHref :: Maybe Text
fileBookmarkTags :: Text
fileBookmarkHref :: FileBookmark -> Text
fileBookmarkDescription :: FileBookmark -> Text
fileBookmarkExtended :: FileBookmark -> Text
fileBookmarkTime :: FileBookmark -> UTCTime
fileBookmarkShared :: FileBookmark -> Bool
fileBookmarkToRead :: FileBookmark -> Bool
fileBookmarkSelected :: FileBookmark -> Maybe Bool
fileBookmarkArchiveHref :: FileBookmark -> Maybe Text
fileBookmarkTags :: FileBookmark -> Text
..} = do
  BmSlug
slug <- IO BmSlug
mkBmSlug
  Bookmark -> IO Bookmark
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bookmark -> IO Bookmark) -> Bookmark -> IO Bookmark
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 = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
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
Text
UTCTime
Key User
BmSlug
bookmarkUserId :: Bookmark -> Key User
bookmarkSlug :: Bookmark -> BmSlug
bookmarkHref :: Bookmark -> Text
bookmarkDescription :: Bookmark -> Text
bookmarkExtended :: Bookmark -> Text
bookmarkTime :: Bookmark -> UTCTime
bookmarkShared :: Bookmark -> Bool
bookmarkToRead :: Bookmark -> Bool
bookmarkSelected :: Bookmark -> Bool
bookmarkArchiveHref :: Bookmark -> Maybe Text
bookmarkUserId :: Key User
bookmarkSlug :: BmSlug
bookmarkHref :: Text
bookmarkDescription :: Text
bookmarkExtended :: Text
bookmarkTime :: UTCTime
bookmarkShared :: Bool
bookmarkToRead :: Bool
bookmarkSelected :: Bool
bookmarkArchiveHref :: Maybe Text
..} 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 = Bool -> Maybe Bool
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
(Int -> FFBookmarkNode -> ShowS)
-> (FFBookmarkNode -> String)
-> ([FFBookmarkNode] -> ShowS)
-> Show FFBookmarkNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FFBookmarkNode -> ShowS
showsPrec :: Int -> FFBookmarkNode -> ShowS
$cshow :: FFBookmarkNode -> String
show :: FFBookmarkNode -> String
$cshowList :: [FFBookmarkNode] -> ShowS
showList :: [FFBookmarkNode] -> ShowS
Show, FFBookmarkNode -> FFBookmarkNode -> Bool
(FFBookmarkNode -> FFBookmarkNode -> Bool)
-> (FFBookmarkNode -> FFBookmarkNode -> Bool) -> Eq FFBookmarkNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FFBookmarkNode -> FFBookmarkNode -> Bool
== :: FFBookmarkNode -> FFBookmarkNode -> Bool
$c/= :: FFBookmarkNode -> FFBookmarkNode -> Bool
/= :: FFBookmarkNode -> FFBookmarkNode -> Bool
Eq, Typeable, Eq FFBookmarkNode
Eq FFBookmarkNode =>
(FFBookmarkNode -> FFBookmarkNode -> Ordering)
-> (FFBookmarkNode -> FFBookmarkNode -> Bool)
-> (FFBookmarkNode -> FFBookmarkNode -> Bool)
-> (FFBookmarkNode -> FFBookmarkNode -> Bool)
-> (FFBookmarkNode -> FFBookmarkNode -> Bool)
-> (FFBookmarkNode -> FFBookmarkNode -> FFBookmarkNode)
-> (FFBookmarkNode -> FFBookmarkNode -> FFBookmarkNode)
-> Ord 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
$ccompare :: FFBookmarkNode -> FFBookmarkNode -> Ordering
compare :: FFBookmarkNode -> FFBookmarkNode -> Ordering
$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
>= :: FFBookmarkNode -> FFBookmarkNode -> Bool
$cmax :: FFBookmarkNode -> FFBookmarkNode -> FFBookmarkNode
max :: FFBookmarkNode -> FFBookmarkNode -> FFBookmarkNode
$cmin :: FFBookmarkNode -> FFBookmarkNode -> FFBookmarkNode
min :: FFBookmarkNode -> FFBookmarkNode -> FFBookmarkNode
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 (Maybe [FFBookmarkNode]
 -> POSIXTime
 -> Text
 -> Maybe Text
 -> Int
 -> Int
 -> POSIXTime
 -> Maybe Text
 -> Text
 -> Text
 -> Int
 -> Maybe Text
 -> FFBookmarkNode)
-> Parser (Maybe [FFBookmarkNode])
-> Parser
     (POSIXTime
      -> Text
      -> Maybe Text
      -> Int
      -> Int
      -> POSIXTime
      -> Maybe Text
      -> Text
      -> Text
      -> Int
      -> Maybe Text
      -> FFBookmarkNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Object
o Object -> Key -> Parser (Maybe [FFBookmarkNode])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"children") Parser
  (POSIXTime
   -> Text
   -> Maybe Text
   -> Int
   -> Int
   -> POSIXTime
   -> Maybe Text
   -> Text
   -> Text
   -> Int
   -> Maybe Text
   -> FFBookmarkNode)
-> Parser POSIXTime
-> Parser
     (Text
      -> Maybe Text
      -> Int
      -> Int
      -> POSIXTime
      -> Maybe Text
      -> Text
      -> Text
      -> Int
      -> Maybe Text
      -> FFBookmarkNode)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o Object -> Key -> Parser POSIXTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dateAdded") Parser
  (Text
   -> Maybe Text
   -> Int
   -> Int
   -> POSIXTime
   -> Maybe Text
   -> Text
   -> Text
   -> Int
   -> Maybe Text
   -> FFBookmarkNode)
-> Parser Text
-> Parser
     (Maybe Text
      -> Int
      -> Int
      -> POSIXTime
      -> Maybe Text
      -> Text
      -> Text
      -> Int
      -> Maybe Text
      -> FFBookmarkNode)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guid" Parser
  (Maybe Text
   -> Int
   -> Int
   -> POSIXTime
   -> Maybe Text
   -> Text
   -> Text
   -> Int
   -> Maybe Text
   -> FFBookmarkNode)
-> Parser (Maybe Text)
-> Parser
     (Int
      -> Int
      -> POSIXTime
      -> Maybe Text
      -> Text
      -> Text
      -> Int
      -> Maybe Text
      -> FFBookmarkNode)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"iconUri") Parser
  (Int
   -> Int
   -> POSIXTime
   -> Maybe Text
   -> Text
   -> Text
   -> Int
   -> Maybe Text
   -> FFBookmarkNode)
-> Parser Int
-> Parser
     (Int
      -> POSIXTime
      -> Maybe Text
      -> Text
      -> Text
      -> Int
      -> Maybe Text
      -> FFBookmarkNode)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" Parser
  (Int
   -> POSIXTime
   -> Maybe Text
   -> Text
   -> Text
   -> Int
   -> Maybe Text
   -> FFBookmarkNode)
-> Parser Int
-> Parser
     (POSIXTime
      -> Maybe Text
      -> Text
      -> Text
      -> Int
      -> Maybe Text
      -> FFBookmarkNode)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index" Parser
  (POSIXTime
   -> Maybe Text
   -> Text
   -> Text
   -> Int
   -> Maybe Text
   -> FFBookmarkNode)
-> Parser POSIXTime
-> Parser
     (Maybe Text -> Text -> Text -> Int -> Maybe Text -> FFBookmarkNode)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o Object -> Key -> Parser POSIXTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lastModified") Parser
  (Maybe Text -> Text -> Text -> Int -> Maybe Text -> FFBookmarkNode)
-> Parser (Maybe Text)
-> Parser (Text -> Text -> Int -> Maybe Text -> FFBookmarkNode)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"root") Parser (Text -> Text -> Int -> Maybe Text -> FFBookmarkNode)
-> Parser Text
-> Parser (Text -> Int -> Maybe Text -> FFBookmarkNode)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title") Parser (Text -> Int -> Maybe Text -> FFBookmarkNode)
-> Parser Text -> Parser (Int -> Maybe Text -> FFBookmarkNode)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type") Parser (Int -> Maybe Text -> FFBookmarkNode)
-> Parser Int -> Parser (Maybe Text -> FFBookmarkNode)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"typeCode") Parser (Maybe Text -> FFBookmarkNode)
-> Parser (Maybe Text) -> Parser FFBookmarkNode
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"uri")
  parseJSON Value
_ = String -> Parser FFBookmarkNode
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
firefoxBookmarkChildren :: FFBookmarkNode -> Maybe [FFBookmarkNode]
firefoxBookmarkDateAdded :: FFBookmarkNode -> POSIXTime
firefoxBookmarkGuid :: FFBookmarkNode -> Text
firefoxBookmarkIconUri :: FFBookmarkNode -> Maybe Text
firefoxBookmarkId :: FFBookmarkNode -> Int
firefoxBookmarkIndex :: FFBookmarkNode -> Int
firefoxBookmarkLastModified :: FFBookmarkNode -> POSIXTime
firefoxBookmarkRoot :: FFBookmarkNode -> Maybe Text
firefoxBookmarkTitle :: FFBookmarkNode -> Text
firefoxBookmarkType :: FFBookmarkNode -> Text
firefoxBookmarkTypeCode :: FFBookmarkNode -> Int
firefoxBookmarkUri :: FFBookmarkNode -> Maybe Text
firefoxBookmarkChildren :: Maybe [FFBookmarkNode]
firefoxBookmarkDateAdded :: POSIXTime
firefoxBookmarkGuid :: Text
firefoxBookmarkIconUri :: Maybe Text
firefoxBookmarkId :: Int
firefoxBookmarkIndex :: Int
firefoxBookmarkLastModified :: POSIXTime
firefoxBookmarkRoot :: Maybe Text
firefoxBookmarkTitle :: Text
firefoxBookmarkType :: Text
firefoxBookmarkTypeCode :: Int
firefoxBookmarkUri :: Maybe Text
..} =
  case Int
firefoxBookmarkTypeCode of
    Int
1 -> do
      BmSlug
slug <- IO BmSlug
mkBmSlug
      [Bookmark] -> IO [Bookmark]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Bookmark] -> IO [Bookmark]) -> [Bookmark] -> IO [Bookmark]
forall a b. (a -> b) -> a -> b
$
        [ Bookmark
          { bookmarkUserId :: Key User
bookmarkUserId = Key User
user
          , bookmarkSlug :: BmSlug
bookmarkSlug = BmSlug
slug
          , bookmarkHref :: Text
bookmarkHref = Text -> Maybe Text -> Text
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 POSIXTime -> POSIXTime -> POSIXTime
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 = Maybe Text
forall a. Maybe a
Nothing
          }
        ]
    Int
2 ->
      [[Bookmark]] -> [Bookmark]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Bookmark]] -> [Bookmark]) -> IO [[Bookmark]] -> IO [Bookmark]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (FFBookmarkNode -> IO [Bookmark])
-> [FFBookmarkNode] -> IO [[Bookmark]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
        (Key User -> FFBookmarkNode -> IO [Bookmark]
firefoxBookmarkNodeToBookmark Key User
user)
        ([FFBookmarkNode] -> Maybe [FFBookmarkNode] -> [FFBookmarkNode]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [FFBookmarkNode]
firefoxBookmarkChildren)
    Int
_ -> [Bookmark] -> IO [Bookmark]
forall a. a -> IO a
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 <- IO (Either String [FileBookmark])
-> ReaderT SqlBackend m (Either String [FileBookmark])
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String [FileBookmark])
 -> ReaderT SqlBackend m (Either String [FileBookmark]))
-> IO (Either String [FileBookmark])
-> ReaderT SqlBackend m (Either String [FileBookmark])
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String [FileBookmark])
forall (m :: * -> *).
MonadIO m =>
String -> m (Either String [FileBookmark])
readFileBookmarks String
bookmarkFile
  case Either String [FileBookmark]
mfmarks of
    Left String
e -> Either String Int -> SqlPersistT m (Either String Int)
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Int -> SqlPersistT m (Either String Int))
-> Either String Int -> SqlPersistT m (Either String Int)
forall a b. (a -> b) -> a -> b
$ String -> Either String Int
forall a b. a -> Either a b
Left String
e
    Right [FileBookmark]
fmarks -> do
      [Bookmark]
bmarks <- IO [Bookmark] -> ReaderT SqlBackend m [Bookmark]
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Bookmark] -> ReaderT SqlBackend m [Bookmark])
-> IO [Bookmark] -> ReaderT SqlBackend m [Bookmark]
forall a b. (a -> b) -> a -> b
$ (FileBookmark -> IO Bookmark) -> [FileBookmark] -> IO [Bookmark]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Key User -> FileBookmark -> IO Bookmark
fileBookmarkToBookmark Key User
userId) [FileBookmark]
fmarks
      [Maybe (Key Bookmark)]
mbids <- (Bookmark -> ReaderT SqlBackend m (Maybe (Key Bookmark)))
-> [Bookmark] -> ReaderT SqlBackend m [Maybe (Key Bookmark)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Bookmark -> ReaderT SqlBackend m (Maybe (Key Bookmark))
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Maybe (Key record))
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Maybe (Key record))
insertUnique [Bookmark]
bmarks
      (Element [BookmarkTag] -> ReaderT SqlBackend m ())
-> [BookmarkTag] -> ReaderT SqlBackend m ()
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
(Element mono -> m ()) -> mono -> m ()
mapM_ (ReaderT SqlBackend m (Maybe (Key BookmarkTag))
-> ReaderT SqlBackend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT SqlBackend m (Maybe (Key BookmarkTag))
 -> ReaderT SqlBackend m ())
-> (BookmarkTag -> ReaderT SqlBackend m (Maybe (Key BookmarkTag)))
-> BookmarkTag
-> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BookmarkTag -> ReaderT SqlBackend m (Maybe (Key BookmarkTag))
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Maybe (Key record))
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Maybe (Key record))
insertUnique) ([BookmarkTag] -> ReaderT SqlBackend m ())
-> [BookmarkTag] -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$
        (Element [(Key Bookmark, [Text])] -> [BookmarkTag])
-> [(Key Bookmark, [Text])] -> [BookmarkTag]
forall mono m.
(MonoFoldable mono, Monoid m) =>
(Element mono -> m) -> mono -> m
concatMap ((Key Bookmark -> [Text] -> [BookmarkTag])
-> (Key Bookmark, [Text]) -> [BookmarkTag]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Key User -> Key Bookmark -> [Text] -> [BookmarkTag]
mkBookmarkTags Key User
userId)) ([(Key Bookmark, [Text])] -> [BookmarkTag])
-> [(Key Bookmark, [Text])] -> [BookmarkTag]
forall a b. (a -> b) -> a -> b
$
        [Maybe (Key Bookmark, [Text])] -> [(Key Bookmark, [Text])]
forall (f :: * -> *) t.
(IsSequence (f (Maybe t)), Functor f,
 Element (f (Maybe t)) ~ Maybe t) =>
f (Maybe t) -> f t
catMaybes ([Maybe (Key Bookmark, [Text])] -> [(Key Bookmark, [Text])])
-> [Maybe (Key Bookmark, [Text])] -> [(Key Bookmark, [Text])]
forall a b. (a -> b) -> a -> b
$
        (Maybe (Key Bookmark) -> [Text] -> Maybe (Key Bookmark, [Text]))
-> [Maybe (Key Bookmark)]
-> [[Text]]
-> [Maybe (Key Bookmark, [Text])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
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) (Key Bookmark -> (Key Bookmark, [Text]))
-> Maybe (Key Bookmark) -> Maybe (Key Bookmark, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Key Bookmark)
mbid)
          [Maybe (Key Bookmark)]
mbids
          (FileBookmark -> [Text]
extractTags (FileBookmark -> [Text]) -> [FileBookmark] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FileBookmark]
fmarks)
      Either String Int -> SqlPersistT m (Either String Int)
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Int -> SqlPersistT m (Either String Int))
-> Either String Int -> SqlPersistT m (Either String Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either String Int
forall a b. b -> Either a b
Right ([Bookmark] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [Bookmark]
bmarks)

  where
    extractTags :: FileBookmark -> [Text]
extractTags = Text -> [Text]
forall t. Textual t => t -> [t]
words (Text -> [Text])
-> (FileBookmark -> Text) -> FileBookmark -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 <- IO (Either String FFBookmarkNode)
-> ReaderT SqlBackend m (Either String FFBookmarkNode)
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String FFBookmarkNode)
 -> ReaderT SqlBackend m (Either String FFBookmarkNode))
-> IO (Either String FFBookmarkNode)
-> ReaderT SqlBackend m (Either String FFBookmarkNode)
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String FFBookmarkNode)
forall (m :: * -> *).
MonadIO m =>
String -> m (Either String FFBookmarkNode)
readFFBookmarks String
bookmarkFile
  case Either String FFBookmarkNode
mfmarks of
    Left String
e -> Either String Int -> SqlPersistT m (Either String Int)
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Int -> SqlPersistT m (Either String Int))
-> Either String Int -> SqlPersistT m (Either String Int)
forall a b. (a -> b) -> a -> b
$ String -> Either String Int
forall a b. a -> Either a b
Left String
e
    Right FFBookmarkNode
fmarks -> do
      [Bookmark]
bmarks <- IO [Bookmark] -> ReaderT SqlBackend m [Bookmark]
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Bookmark] -> ReaderT SqlBackend m [Bookmark])
-> IO [Bookmark] -> ReaderT SqlBackend m [Bookmark]
forall a b. (a -> b) -> a -> b
$ Key User -> FFBookmarkNode -> IO [Bookmark]
firefoxBookmarkNodeToBookmark Key User
userId FFBookmarkNode
fmarks
      (Element [Bookmark] -> ReaderT SqlBackend m ())
-> [Bookmark] -> ReaderT SqlBackend m ()
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
(Element mono -> m ()) -> mono -> m ()
mapM_ (ReaderT SqlBackend m (Maybe (Key Bookmark))
-> ReaderT SqlBackend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT SqlBackend m (Maybe (Key Bookmark))
 -> ReaderT SqlBackend m ())
-> (Bookmark -> ReaderT SqlBackend m (Maybe (Key Bookmark)))
-> Bookmark
-> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bookmark -> ReaderT SqlBackend m (Maybe (Key Bookmark))
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Maybe (Key record))
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Maybe (Key record))
insertUnique) [Bookmark]
bmarks
      Either String Int -> SqlPersistT m (Either String Int)
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Int -> SqlPersistT m (Either String Int))
-> Either String Int -> SqlPersistT m (Either String Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either String Int
forall a b. b -> Either a b
Right ([Bookmark] -> Int
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 =
  ByteString -> Either String [FileBookmark]
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode' (ByteString -> Either String [FileBookmark])
-> (ByteString -> ByteString)
-> ByteString
-> Either String [FileBookmark]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
forall lazy strict. LazySequence lazy strict => strict -> lazy
fromStrict (ByteString -> Either String [FileBookmark])
-> m ByteString -> m (Either String [FileBookmark])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ByteString
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 =
  ByteString -> Either String FFBookmarkNode
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode' (ByteString -> Either String FFBookmarkNode)
-> (ByteString -> ByteString)
-> ByteString
-> Either String FFBookmarkNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
forall lazy strict. LazySequence lazy strict => strict -> lazy
fromStrict (ByteString -> Either String FFBookmarkNode)
-> m ByteString -> m (Either String FFBookmarkNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ByteString
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 =
    IO () -> ReaderT SqlBackend m ()
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> ([FileBookmark] -> IO ())
-> [FileBookmark]
-> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> [FileBookmark] -> IO ()
forall a. ToJSON a => String -> a -> IO ()
A.encodeFile String
fpath ([FileBookmark] -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m [FileBookmark] -> ReaderT SqlBackend m ()
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
  [FileBookmark] -> SqlPersistT m [FileBookmark]
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileBookmark] -> SqlPersistT m [FileBookmark])
-> [FileBookmark] -> SqlPersistT m [FileBookmark]
forall a b. (a -> b) -> a -> b
$ ((Entity Bookmark, Text) -> FileBookmark)
-> [(Entity Bookmark, Text)] -> [FileBookmark]
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 (Entity Bookmark -> Bookmark
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
(Int -> TagCloudMode -> ShowS)
-> (TagCloudMode -> String)
-> ([TagCloudMode] -> ShowS)
-> Show TagCloudMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TagCloudMode -> ShowS
showsPrec :: Int -> TagCloudMode -> ShowS
$cshow :: TagCloudMode -> String
show :: TagCloudMode -> String
$cshowList :: [TagCloudMode] -> ShowS
showList :: [TagCloudMode] -> ShowS
Show, TagCloudMode -> TagCloudMode -> Bool
(TagCloudMode -> TagCloudMode -> Bool)
-> (TagCloudMode -> TagCloudMode -> Bool) -> Eq TagCloudMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TagCloudMode -> TagCloudMode -> Bool
== :: TagCloudMode -> TagCloudMode -> Bool
$c/= :: TagCloudMode -> TagCloudMode -> Bool
/= :: TagCloudMode -> TagCloudMode -> Bool
Eq, ReadPrec [TagCloudMode]
ReadPrec TagCloudMode
Int -> ReadS TagCloudMode
ReadS [TagCloudMode]
(Int -> ReadS TagCloudMode)
-> ReadS [TagCloudMode]
-> ReadPrec TagCloudMode
-> ReadPrec [TagCloudMode]
-> Read TagCloudMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TagCloudMode
readsPrec :: Int -> ReadS TagCloudMode
$creadList :: ReadS [TagCloudMode]
readList :: ReadS [TagCloudMode]
$creadPrec :: ReadPrec TagCloudMode
readPrec :: ReadPrec TagCloudMode
$creadListPrec :: ReadPrec [TagCloudMode]
readListPrec :: ReadPrec [TagCloudMode]
Read, (forall x. TagCloudMode -> Rep TagCloudMode x)
-> (forall x. Rep TagCloudMode x -> TagCloudMode)
-> Generic TagCloudMode
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
$cfrom :: forall x. TagCloudMode -> Rep TagCloudMode x
from :: forall x. TagCloudMode -> Rep TagCloudMode x
$cto :: forall x. Rep TagCloudMode x -> TagCloudMode
to :: forall x. Rep TagCloudMode x -> TagCloudMode
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 Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"mode" Object
o of
      Just (String Text
"top") -> Bool -> Int -> TagCloudMode
TagCloudModeTop (Bool -> Int -> TagCloudMode)
-> Parser Bool -> Parser (Int -> TagCloudMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expanded" Parser (Int -> TagCloudMode) -> Parser Int -> Parser TagCloudMode
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      Just (String Text
"lowerBound") -> Bool -> Int -> TagCloudMode
TagCloudModeLowerBound (Bool -> Int -> TagCloudMode)
-> Parser Bool -> Parser (Int -> TagCloudMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expanded" Parser (Int -> TagCloudMode) -> Parser Int -> Parser TagCloudMode
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      Just (String Text
"related") -> Bool -> [Text] -> TagCloudMode
TagCloudModeRelated (Bool -> [Text] -> TagCloudMode)
-> Parser Bool -> Parser ([Text] -> TagCloudMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expanded" Parser ([Text] -> TagCloudMode)
-> Parser [Text] -> Parser TagCloudMode
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> [Text]) -> Parser Text -> Parser [Text]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Text]
forall t. Textual t => t -> [t]
words (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value")
      Just (String Text
"none") -> TagCloudMode -> Parser TagCloudMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TagCloudMode
TagCloudModeNone
      Maybe Value
_ -> String -> Parser TagCloudMode
forall a. String -> Parser a
A.parseFail String
"bad parse"
  parseJSON Value
_ = String -> Parser TagCloudMode
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" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"top"
           , Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
i
           , Key
"expanded" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool -> Value
Bool Bool
e
           ]
  toJSON (TagCloudModeLowerBound Bool
e Int
i) =
    [Pair] -> Value
object [ Key
"mode" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"lowerBound"
           , Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
i
           , Key
"expanded" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool -> Value
Bool Bool
e
           ]
  toJSON (TagCloudModeRelated Bool
e [Text]
tags) =
    [Pair] -> Value
object [ Key
"mode" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"related"
           , Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords [Text]
tags)
           , Key
"expanded" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool -> Value
Bool Bool
e
           ]
  toJSON TagCloudMode
TagCloudModeNone =
    [Pair] -> Value
object [ Key
"mode" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"none"
           , Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
Null
           , Key
"expanded" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e 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 =
    (Element [(Text, Int)] -> Text) -> [(Text, Int)] -> [(Text, Int)]
forall o seq.
(Ord o, SemiSequence seq) =>
(Element seq -> o) -> seq -> seq
sortOn (Text -> Text
forall t. Textual t => t -> t
toLower (Text -> Text) -> ((Text, Int) -> Text) -> (Text, Int) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text, Int) -> Text
forall a b. (a, b) -> a
fst) ([(Text, Int)] -> [(Text, Int)])
-> ([(Value Text, Value Int)] -> [(Text, Int)])
-> [(Value Text, Value Int)]
-> [(Text, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
    ((Value Text, Value Int) -> (Text, Int))
-> [(Value Text, Value Int)] -> [(Text, Int)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value Text -> Text)
-> (Value Int -> Int) -> (Value Text, Value Int) -> (Text, Int)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Value Text -> Text
forall a. Value a -> a
unValue Value Int -> Int
forall a. Value a -> a
unValue) ([(Value Text, Value Int)] -> [(Text, Int)])
-> ReaderT SqlBackend m [(Value Text, Value Int)]
-> ReaderT SqlBackend m [(Text, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( SqlQuery (SqlExpr (Value Text), SqlExpr (Value Int))
-> ReaderT SqlBackend m [(Value Text, Value Int)]
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select (SqlQuery (SqlExpr (Value Text), SqlExpr (Value Int))
 -> ReaderT SqlBackend m [(Value Text, Value Int)])
-> SqlQuery (SqlExpr (Value Text), SqlExpr (Value Int))
-> ReaderT SqlBackend m [(Value Text, Value Int)]
forall a b. (a -> b) -> a -> b
$ do
      SqlExpr (Entity BookmarkTag)
t <- From (SqlExpr (Entity BookmarkTag))
-> SqlQuery (SqlExpr (Entity BookmarkTag))
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 SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key User) -> SqlExpr (Value (Key User))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key User)
forall typ. (typ ~ Key User) => EntityField BookmarkTag typ
BookmarkTagUserId SqlExpr (Value (Key User))
-> SqlExpr (Value (Key User)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Key User -> SqlExpr (Value (Key User))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key User
user)
      SqlExpr (Value Text) -> SqlQuery ()
forall a. ToSomeValues a => a -> SqlQuery ()
groupBy (SqlExpr (Value Text) -> SqlExpr (Value Text)
forall s. SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
lower_ (SqlExpr (Value Text) -> SqlExpr (Value Text))
-> SqlExpr (Value Text) -> SqlExpr (Value Text)
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag)
      let countRows' :: SqlExpr (Value Int)
countRows' = SqlExpr (Value Int)
forall a. Num a => SqlExpr (Value a)
countRows
      [SqlExpr OrderBy] -> SqlQuery ()
orderBy [SqlExpr (Value Int) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
desc SqlExpr (Value Int)
countRows']
      Limit -> SqlQuery ()
limit ((Integer -> Limit
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Limit) -> (Int -> Integer) -> Int -> Limit
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger) Int
top)
      (SqlExpr (Value Text), SqlExpr (Value Int))
-> SqlQuery (SqlExpr (Value Text), SqlExpr (Value Int))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
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 =
    ((Value Text, Value Int) -> (Text, Int))
-> [(Value Text, Value Int)] -> [(Text, Int)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value Text -> Text)
-> (Value Int -> Int) -> (Value Text, Value Int) -> (Text, Int)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Value Text -> Text
forall a. Value a -> a
unValue Value Int -> Int
forall a. Value a -> a
unValue) ([(Value Text, Value Int)] -> [(Text, Int)])
-> ReaderT SqlBackend m [(Value Text, Value Int)]
-> ReaderT SqlBackend m [(Text, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( SqlQuery (SqlExpr (Value Text), SqlExpr (Value Int))
-> ReaderT SqlBackend m [(Value Text, Value Int)]
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select (SqlQuery (SqlExpr (Value Text), SqlExpr (Value Int))
 -> ReaderT SqlBackend m [(Value Text, Value Int)])
-> SqlQuery (SqlExpr (Value Text), SqlExpr (Value Int))
-> ReaderT SqlBackend m [(Value Text, Value Int)]
forall a b. (a -> b) -> a -> b
$ do
      SqlExpr (Entity BookmarkTag)
t <- From (SqlExpr (Entity BookmarkTag))
-> SqlQuery (SqlExpr (Entity BookmarkTag))
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 SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key User) -> SqlExpr (Value (Key User))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key User)
forall typ. (typ ~ Key User) => EntityField BookmarkTag typ
BookmarkTagUserId SqlExpr (Value (Key User))
-> SqlExpr (Value (Key User)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Key User -> SqlExpr (Value (Key User))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key User
user)
      SqlExpr (Value Text) -> SqlQuery ()
forall a. ToSomeValues a => a -> SqlQuery ()
groupBy (SqlExpr (Value Text) -> SqlExpr (Value Text)
forall s. SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
lower_ (SqlExpr (Value Text) -> SqlExpr (Value Text))
-> SqlExpr (Value Text) -> SqlExpr (Value Text)
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag)
      let countRows' :: SqlExpr (Value Int)
countRows' = SqlExpr (Value Int)
forall a. Num a => SqlExpr (Value a)
countRows
      [SqlExpr OrderBy] -> SqlQuery ()
orderBy [SqlExpr (Value Text) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
asc (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag)]
      SqlExpr (Value Bool) -> SqlQuery ()
having (SqlExpr (Value Int)
countRows' SqlExpr (Value Int) -> SqlExpr (Value Int) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
>=. Int -> SqlExpr (Value Int)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Int
lowerBound)
      (SqlExpr (Value Text), SqlExpr (Value Int))
-> SqlQuery (SqlExpr (Value Text), SqlExpr (Value Int))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
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 =
    ((Value Text, Value Int) -> (Text, Int))
-> [(Value Text, Value Int)] -> [(Text, Int)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value Text -> Text)
-> (Value Int -> Int) -> (Value Text, Value Int) -> (Text, Int)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Value Text -> Text
forall a. Value a -> a
unValue Value Int -> Int
forall a. Value a -> a
unValue) ([(Value Text, Value Int)] -> [(Text, Int)])
-> ReaderT SqlBackend m [(Value Text, Value Int)]
-> ReaderT SqlBackend m [(Text, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( SqlQuery (SqlExpr (Value Text), SqlExpr (Value Int))
-> ReaderT SqlBackend m [(Value Text, Value Int)]
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select (SqlQuery (SqlExpr (Value Text), SqlExpr (Value Int))
 -> ReaderT SqlBackend m [(Value Text, Value Int)])
-> SqlQuery (SqlExpr (Value Text), SqlExpr (Value Int))
-> ReaderT SqlBackend m [(Value Text, Value Int)]
forall a b. (a -> b) -> a -> b
$ do
      SqlExpr (Entity BookmarkTag)
t <- From (SqlExpr (Entity BookmarkTag))
-> SqlQuery (SqlExpr (Entity BookmarkTag))
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 (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$
        (SqlExpr (Value Bool) -> Text -> SqlExpr (Value Bool))
-> SqlExpr (Value Bool) -> [Text] -> SqlExpr (Value Bool)
forall b a. (b -> a -> b) -> 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 <- From (SqlExpr (Entity BookmarkTag))
-> SqlQuery (SqlExpr (Entity BookmarkTag))
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 SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId SqlExpr (Value (Key Bookmark))
-> SqlExpr (Value (Key Bookmark)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key Bookmark)
-> SqlExpr (Value (Key Bookmark))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&.
                                 (SqlExpr (Entity BookmarkTag)
u SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
`like` Text -> SqlExpr (Value Text)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Text
tag))))
          (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag (Key User) -> SqlExpr (Value (Key User))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag (Key User)
forall typ. (typ ~ Key User) => EntityField BookmarkTag typ
BookmarkTagUserId SqlExpr (Value (Key User))
-> SqlExpr (Value (Key User)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Key User -> SqlExpr (Value (Key User))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key User
user)
          [Text]
tags
      SqlExpr (Value Text) -> SqlQuery ()
forall a. ToSomeValues a => a -> SqlQuery ()
groupBy (SqlExpr (Value Text) -> SqlExpr (Value Text)
forall s. SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
lower_ (SqlExpr (Value Text) -> SqlExpr (Value Text))
-> SqlExpr (Value Text) -> SqlExpr (Value Text)
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag)
      let countRows' :: SqlExpr (Value Int)
countRows' = SqlExpr (Value Int)
forall a. Num a => SqlExpr (Value a)
countRows
      [SqlExpr OrderBy] -> SqlQuery ()
orderBy [SqlExpr (Value Text) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
asc (SqlExpr (Value Text) -> SqlExpr OrderBy)
-> SqlExpr (Value Text) -> SqlExpr OrderBy
forall a b. (a -> b) -> a -> b
$ SqlExpr (Value Text) -> SqlExpr (Value Text)
forall s. SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
lower_ (SqlExpr (Value Text) -> SqlExpr (Value Text))
-> SqlExpr (Value Text) -> SqlExpr (Value Text)
forall a b. (a -> b) -> a -> b
$ (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
forall typ. (typ ~ Text) => EntityField BookmarkTag typ
BookmarkTagTag)]
      (SqlExpr (Value Text), SqlExpr (Value Int))
-> SqlQuery (SqlExpr (Value Text), SqlExpr (Value Int))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity BookmarkTag)
t SqlExpr (Entity BookmarkTag)
-> EntityField BookmarkTag Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField BookmarkTag Text
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
Text
UTCTime
fileNoteId :: Text
fileNoteTitle :: Text
fileNoteText :: Text
fileNoteLength :: Int
fileNoteCreatedAt :: UTCTime
fileNoteUpdatedAt :: UTCTime
fileNoteId :: FileNote -> Text
fileNoteTitle :: FileNote -> Text
fileNoteText :: FileNote -> Text
fileNoteLength :: FileNote -> Int
fileNoteCreatedAt :: FileNote -> UTCTime
fileNoteUpdatedAt :: FileNote -> UTCTime
..}  = do
  NtSlug
slug <- IO NtSlug
mkNtSlug
  Note -> IO Note
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Note -> IO Note) -> Note -> IO Note
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 <- IO (Either String [FileNote])
-> ReaderT SqlBackend m (Either String [FileNote])
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String [FileNote])
 -> ReaderT SqlBackend m (Either String [FileNote]))
-> IO (Either String [FileNote])
-> ReaderT SqlBackend m (Either String [FileNote])
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String [FileNote])
forall (m :: * -> *).
MonadIO m =>
String -> m (Either String [FileNote])
readFileNotes String
noteDirectory
  case Either String [FileNote]
mfnotes of
      Left String
e -> Either String Int -> SqlPersistT m (Either String Int)
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Int -> SqlPersistT m (Either String Int))
-> Either String Int -> SqlPersistT m (Either String Int)
forall a b. (a -> b) -> a -> b
$ String -> Either String Int
forall a b. a -> Either a b
Left String
e
      Right [FileNote]
fnotes -> do
        [Note]
notes <- IO [Note] -> ReaderT SqlBackend m [Note]
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Note] -> ReaderT SqlBackend m [Note])
-> IO [Note] -> ReaderT SqlBackend m [Note]
forall a b. (a -> b) -> a -> b
$ (FileNote -> IO Note) -> [FileNote] -> IO [Note]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Key User -> FileNote -> IO Note
fileNoteToNote Key User
userId) [FileNote]
fnotes
        ReaderT SqlBackend m [Maybe (Key Note)] -> ReaderT SqlBackend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT SqlBackend m [Maybe (Key Note)]
 -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m [Maybe (Key Note)]
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ (Note -> ReaderT SqlBackend m (Maybe (Key Note)))
-> [Note] -> ReaderT SqlBackend m [Maybe (Key Note)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Note -> ReaderT SqlBackend m (Maybe (Key Note))
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Maybe (Key record))
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Maybe (Key record))
insertUnique [Note]
notes
        Either String Int -> SqlPersistT m (Either String Int)
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Int -> SqlPersistT m (Either String Int))
-> Either String Int -> SqlPersistT m (Either String Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either String Int
forall a b. b -> Either a b
Right ([Note] -> Int
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 <- IO [String] -> m [String]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
fdir)
      [ByteString]
noteBSS <- (String -> m ByteString) -> [String] -> m [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> m ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
readFile (String -> m ByteString) -> ShowS -> String -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
      Either String [FileNote] -> m (Either String [FileNote])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString -> Either String FileNote)
-> [ByteString] -> Either String [FileNote]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ByteString -> Either String FileNote
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode' (ByteString -> Either String FileNote)
-> (ByteString -> ByteString)
-> ByteString
-> Either String FileNote
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
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
(Int -> AccountSettingsForm -> ShowS)
-> (AccountSettingsForm -> String)
-> ([AccountSettingsForm] -> ShowS)
-> Show AccountSettingsForm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccountSettingsForm -> ShowS
showsPrec :: Int -> AccountSettingsForm -> ShowS
$cshow :: AccountSettingsForm -> String
show :: AccountSettingsForm -> String
$cshowList :: [AccountSettingsForm] -> ShowS
showList :: [AccountSettingsForm] -> ShowS
Show, AccountSettingsForm -> AccountSettingsForm -> Bool
(AccountSettingsForm -> AccountSettingsForm -> Bool)
-> (AccountSettingsForm -> AccountSettingsForm -> Bool)
-> Eq AccountSettingsForm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccountSettingsForm -> AccountSettingsForm -> Bool
== :: AccountSettingsForm -> AccountSettingsForm -> Bool
$c/= :: AccountSettingsForm -> AccountSettingsForm -> Bool
/= :: AccountSettingsForm -> AccountSettingsForm -> Bool
Eq, ReadPrec [AccountSettingsForm]
ReadPrec AccountSettingsForm
Int -> ReadS AccountSettingsForm
ReadS [AccountSettingsForm]
(Int -> ReadS AccountSettingsForm)
-> ReadS [AccountSettingsForm]
-> ReadPrec AccountSettingsForm
-> ReadPrec [AccountSettingsForm]
-> Read AccountSettingsForm
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AccountSettingsForm
readsPrec :: Int -> ReadS AccountSettingsForm
$creadList :: ReadS [AccountSettingsForm]
readList :: ReadS [AccountSettingsForm]
$creadPrec :: ReadPrec AccountSettingsForm
readPrec :: ReadPrec AccountSettingsForm
$creadListPrec :: ReadPrec [AccountSettingsForm]
readListPrec :: ReadPrec [AccountSettingsForm]
Read, (forall x. AccountSettingsForm -> Rep AccountSettingsForm x)
-> (forall x. Rep AccountSettingsForm x -> AccountSettingsForm)
-> Generic AccountSettingsForm
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
$cfrom :: forall x. AccountSettingsForm -> Rep AccountSettingsForm x
from :: forall x. AccountSettingsForm -> Rep AccountSettingsForm x
$cto :: forall x. Rep AccountSettingsForm x -> AccountSettingsForm
to :: forall x. Rep AccountSettingsForm x -> AccountSettingsForm
Generic)

instance FromJSON AccountSettingsForm where parseJSON :: Value -> Parser AccountSettingsForm
parseJSON = Options -> Value -> Parser AccountSettingsForm
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON Options
gDefaultFormOptions
instance ToJSON AccountSettingsForm where toJSON :: AccountSettingsForm -> Value
toJSON = Options -> AccountSettingsForm -> Value
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
userName :: User -> Text
userPasswordHash :: User -> BCrypt
userApiToken :: User -> Maybe HashedApiKey
userPrivateDefault :: User -> Bool
userArchiveDefault :: User -> Bool
userPrivacyLock :: User -> Bool
userName :: Text
userPasswordHash :: BCrypt
userApiToken :: Maybe HashedApiKey
userPrivateDefault :: Bool
userArchiveDefault :: Bool
userPrivacyLock :: Bool
..} =
  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
_privateDefault :: AccountSettingsForm -> Bool
_archiveDefault :: AccountSettingsForm -> Bool
_privacyLock :: AccountSettingsForm -> Bool
_privateDefault :: Bool
_archiveDefault :: Bool
_privacyLock :: Bool
..} =
  Key User -> [Update User] -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Key record -> [Update record] -> ReaderT SqlBackend m ()
CP.update Key User
userId
  [ EntityField User Bool
forall typ. (typ ~ Bool) => EntityField User typ
UserPrivateDefault EntityField User Bool -> Bool -> Update User
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
CP.=. Bool
_privateDefault
  , EntityField User Bool
forall typ. (typ ~ Bool) => EntityField User typ
UserArchiveDefault EntityField User Bool -> Bool -> Update User
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
CP.=. Bool
_archiveDefault
  , EntityField User Bool
forall typ. (typ ~ Bool) => EntityField User typ
UserPrivacyLock EntityField User Bool -> Bool -> Update User
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 Limit
_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
(Int -> BookmarkForm -> ShowS)
-> (BookmarkForm -> String)
-> ([BookmarkForm] -> ShowS)
-> Show BookmarkForm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BookmarkForm -> ShowS
showsPrec :: Int -> BookmarkForm -> ShowS
$cshow :: BookmarkForm -> String
show :: BookmarkForm -> String
$cshowList :: [BookmarkForm] -> ShowS
showList :: [BookmarkForm] -> ShowS
Show, BookmarkForm -> BookmarkForm -> Bool
(BookmarkForm -> BookmarkForm -> Bool)
-> (BookmarkForm -> BookmarkForm -> Bool) -> Eq BookmarkForm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BookmarkForm -> BookmarkForm -> Bool
== :: BookmarkForm -> BookmarkForm -> Bool
$c/= :: BookmarkForm -> BookmarkForm -> Bool
/= :: BookmarkForm -> BookmarkForm -> Bool
Eq, ReadPrec [BookmarkForm]
ReadPrec BookmarkForm
Int -> ReadS BookmarkForm
ReadS [BookmarkForm]
(Int -> ReadS BookmarkForm)
-> ReadS [BookmarkForm]
-> ReadPrec BookmarkForm
-> ReadPrec [BookmarkForm]
-> Read BookmarkForm
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BookmarkForm
readsPrec :: Int -> ReadS BookmarkForm
$creadList :: ReadS [BookmarkForm]
readList :: ReadS [BookmarkForm]
$creadPrec :: ReadPrec BookmarkForm
readPrec :: ReadPrec BookmarkForm
$creadListPrec :: ReadPrec [BookmarkForm]
readListPrec :: ReadPrec [BookmarkForm]
Read, (forall x. BookmarkForm -> Rep BookmarkForm x)
-> (forall x. Rep BookmarkForm x -> BookmarkForm)
-> Generic BookmarkForm
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
$cfrom :: forall x. BookmarkForm -> Rep BookmarkForm x
from :: forall x. BookmarkForm -> Rep BookmarkForm x
$cto :: forall x. Rep BookmarkForm x -> BookmarkForm
to :: forall x. Rep BookmarkForm x -> BookmarkForm
Generic)

instance FromJSON BookmarkForm where parseJSON :: Value -> Parser BookmarkForm
parseJSON = Options -> Value -> Parser BookmarkForm
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON Options
gDefaultFormOptions
instance ToJSON BookmarkForm where toJSON :: BookmarkForm -> Value
toJSON = Options -> BookmarkForm -> Value
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 { A.fieldLabelModifier = drop 1 }

toBookmarkFormList :: [(Entity Bookmark, Maybe Text)] -> [BookmarkForm]
toBookmarkFormList :: [(Entity Bookmark, Maybe Text)] -> [BookmarkForm]
toBookmarkFormList = ((Entity Bookmark, Maybe Text) -> BookmarkForm)
-> [(Entity Bookmark, Maybe Text)] -> [BookmarkForm]
forall a b. (a -> b) -> [a] -> [b]
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, Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Entity BookmarkTag -> Text) -> [Entity BookmarkTag] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BookmarkTag -> Text
bookmarkTagTag (BookmarkTag -> Text)
-> (Entity BookmarkTag -> BookmarkTag)
-> Entity BookmarkTag
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Entity BookmarkTag -> BookmarkTag
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
Text
UTCTime
Key User
BmSlug
bookmarkUserId :: Bookmark -> Key User
bookmarkSlug :: Bookmark -> BmSlug
bookmarkHref :: Bookmark -> Text
bookmarkDescription :: Bookmark -> Text
bookmarkExtended :: Bookmark -> Text
bookmarkTime :: Bookmark -> UTCTime
bookmarkShared :: Bookmark -> Bool
bookmarkToRead :: Bookmark -> Bool
bookmarkSelected :: Bookmark -> Bool
bookmarkArchiveHref :: Bookmark -> Maybe Text
bookmarkUserId :: Key User
bookmarkSlug :: BmSlug
bookmarkHref :: Text
bookmarkDescription :: Text
bookmarkExtended :: Text
bookmarkTime :: UTCTime
bookmarkShared :: Bool
bookmarkToRead :: Bool
bookmarkSelected :: Bool
bookmarkArchiveHref :: Maybe Text
..}, Maybe Text
tags) =
  BookmarkForm
  { _url :: Text
_url = Text
bookmarkHref
  , _title :: Maybe Text
_title = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
bookmarkDescription
  , _description :: Maybe Textarea
_description = Textarea -> Maybe Textarea
forall a. a -> Maybe a
Just (Textarea -> Maybe Textarea) -> Textarea -> Maybe Textarea
forall a b. (a -> b) -> a -> b
$ Text -> Textarea
Textarea (Text -> Textarea) -> Text -> Textarea
forall a b. (a -> b) -> a -> b
$ Text
bookmarkExtended
  , _tags :: Maybe Text
_tags = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
tags
  , _private :: Maybe Bool
_private = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
bookmarkShared
  , _toread :: Maybe Bool
_toread = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
bookmarkToRead
  , _bid :: Maybe Limit
_bid = Limit -> Maybe Limit
forall a. a -> Maybe a
Just (Limit -> Maybe Limit) -> Limit -> Maybe Limit
forall a b. (a -> b) -> a -> b
$ Key Bookmark -> Limit
forall record.
ToBackendKey SqlBackend record =>
Key record -> Limit
fromSqlKey (Key Bookmark -> Limit) -> Key Bookmark -> Limit
forall a b. (a -> b) -> a -> b
$ Key Bookmark
bid
  , _slug :: Maybe BmSlug
_slug = BmSlug -> Maybe BmSlug
forall a. a -> Maybe a
Just BmSlug
bookmarkSlug
  , _selected :: Maybe Bool
_selected = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
bookmarkSelected
  , _time :: Maybe UTCTimeStr
_time = UTCTimeStr -> Maybe UTCTimeStr
forall a. a -> Maybe a
Just (UTCTimeStr -> Maybe UTCTimeStr) -> UTCTimeStr -> Maybe UTCTimeStr
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTimeStr
UTCTimeStr (UTCTime -> UTCTimeStr) -> UTCTime -> 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 Limit
Maybe Text
Maybe Textarea
Maybe BmSlug
Maybe UTCTimeStr
Text
_url :: BookmarkForm -> Text
_title :: BookmarkForm -> Maybe Text
_description :: BookmarkForm -> Maybe Textarea
_tags :: BookmarkForm -> Maybe Text
_private :: BookmarkForm -> Maybe Bool
_toread :: BookmarkForm -> Maybe Bool
_bid :: BookmarkForm -> Maybe Limit
_slug :: BookmarkForm -> Maybe BmSlug
_selected :: BookmarkForm -> Maybe Bool
_time :: BookmarkForm -> Maybe UTCTimeStr
_archiveUrl :: BookmarkForm -> Maybe Text
_url :: Text
_title :: Maybe Text
_description :: Maybe Textarea
_tags :: Maybe Text
_private :: Maybe Bool
_toread :: Maybe Bool
_bid :: Maybe Limit
_slug :: Maybe BmSlug
_selected :: Maybe Bool
_time :: Maybe UTCTimeStr
_archiveUrl :: Maybe Text
..} = do
  UTCTime
time <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  BmSlug
slug <- IO BmSlug -> (BmSlug -> IO BmSlug) -> Maybe BmSlug -> IO BmSlug
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO BmSlug
mkBmSlug BmSlug -> IO BmSlug
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe BmSlug
_slug
  Bookmark -> IO Bookmark
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bookmark -> IO Bookmark) -> Bookmark -> IO Bookmark
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 = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
_title
    , bookmarkExtended :: Text
bookmarkExtended = Text -> (Textarea -> Text) -> Maybe Textarea -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Textarea -> Text
unTextarea Maybe Textarea
_description
    , bookmarkTime :: UTCTime
bookmarkTime = UTCTime -> (UTCTimeStr -> UTCTime) -> Maybe UTCTimeStr -> UTCTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UTCTime
time UTCTimeStr -> UTCTime
unUTCTimeStr Maybe UTCTimeStr
_time
    , bookmarkShared :: Bool
bookmarkShared = Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Bool -> Bool
not Maybe Bool
_private
    , bookmarkToRead :: Bool
bookmarkToRead = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Bool
_toread
    , bookmarkSelected :: Bool
bookmarkSelected = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
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 = MaybeT
  (ReaderT SqlBackend m) (Entity Bookmark, [Entity BookmarkTag])
-> ReaderT
     SqlBackend m (Maybe (Entity Bookmark, [Entity BookmarkTag]))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  Entity Bookmark
bmark <- ReaderT SqlBackend m (Maybe (Entity Bookmark))
-> MaybeT (ReaderT SqlBackend m) (Entity Bookmark)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT SqlBackend m (Maybe (Entity Bookmark))
 -> MaybeT (ReaderT SqlBackend m) (Entity Bookmark))
-> (Text -> ReaderT SqlBackend m (Maybe (Entity Bookmark)))
-> Text
-> MaybeT (ReaderT SqlBackend m) (Entity Bookmark)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Unique Bookmark -> ReaderT SqlBackend m (Maybe (Entity Bookmark))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Unique record -> ReaderT SqlBackend m (Maybe (Entity record))
getBy (Unique Bookmark -> ReaderT SqlBackend m (Maybe (Entity Bookmark)))
-> (Text -> Unique Bookmark)
-> Text
-> ReaderT SqlBackend m (Maybe (Entity Bookmark))
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 (Text -> MaybeT (ReaderT SqlBackend m) (Entity Bookmark))
-> MaybeT (ReaderT SqlBackend m) Text
-> MaybeT (ReaderT SqlBackend m) (Entity Bookmark)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT SqlBackend m (Maybe Text)
-> MaybeT (ReaderT SqlBackend m) Text
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe Text -> ReaderT SqlBackend m (Maybe Text)
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
murl)
  [Entity BookmarkTag]
btags <- ReaderT SqlBackend m [Entity BookmarkTag]
-> MaybeT (ReaderT SqlBackend m) [Entity BookmarkTag]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT SqlBackend m [Entity BookmarkTag]
 -> MaybeT (ReaderT SqlBackend m) [Entity BookmarkTag])
-> ReaderT SqlBackend m [Entity BookmarkTag]
-> MaybeT (ReaderT SqlBackend m) [Entity BookmarkTag]
forall a b. (a -> b) -> a -> b
$ Key Bookmark -> DB [Entity BookmarkTag]
withTags (Entity Bookmark -> Key Bookmark
forall record. Entity record -> Key record
entityKey Entity Bookmark
bmark)
  (Entity Bookmark, [Entity BookmarkTag])
-> MaybeT
     (ReaderT SqlBackend m) (Entity Bookmark, [Entity BookmarkTag])
forall a. a -> MaybeT (ReaderT SqlBackend m) a
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
[UpsertResult a] -> ShowS
UpsertResult a -> String
(Int -> UpsertResult a -> ShowS)
-> (UpsertResult a -> String)
-> ([UpsertResult a] -> ShowS)
-> Show (UpsertResult a)
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
$cshowsPrec :: forall a. Show a => Int -> UpsertResult a -> ShowS
showsPrec :: Int -> UpsertResult a -> ShowS
$cshow :: forall a. Show a => UpsertResult a -> String
show :: UpsertResult a -> String
$cshowList :: forall a. Show a => [UpsertResult a] -> ShowS
showList :: [UpsertResult a] -> ShowS
Show, UpsertResult a -> UpsertResult a -> Bool
(UpsertResult a -> UpsertResult a -> Bool)
-> (UpsertResult a -> UpsertResult a -> Bool)
-> Eq (UpsertResult a)
forall a. Eq a => UpsertResult a -> UpsertResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: UpsertResult a -> UpsertResult a -> Bool
Eq, (forall a b. (a -> b) -> UpsertResult a -> UpsertResult b)
-> (forall a b. a -> UpsertResult b -> UpsertResult a)
-> Functor UpsertResult
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
$cfmap :: forall a b. (a -> b) -> UpsertResult a -> UpsertResult b
fmap :: forall a b. (a -> b) -> UpsertResult a -> UpsertResult b
$c<$ :: forall a b. a -> UpsertResult b -> UpsertResult a
<$ :: forall a b. a -> UpsertResult b -> UpsertResult a
Functor)

maybeUpsertResult :: UpsertResult a -> Maybe a
maybeUpsertResult :: forall a. UpsertResult a -> Maybe a
maybeUpsertResult (Created a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
maybeUpsertResult (Updated a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
maybeUpsertResult UpsertResult a
_ = Maybe 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 ->
      Key Bookmark -> ReaderT SqlBackend m (Maybe Bookmark)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Key record -> ReaderT SqlBackend m (Maybe record)
get Key Bookmark
bid ReaderT SqlBackend m (Maybe Bookmark)
-> (Maybe Bookmark -> SqlPersistT m (UpsertResult (Key Bookmark)))
-> SqlPersistT m (UpsertResult (Key Bookmark))
forall a b.
ReaderT SqlBackend m a
-> (a -> ReaderT SqlBackend m b) -> ReaderT SqlBackend m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Bookmark
prev_bm | Key User
userId Key User -> Key User -> Bool
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
_ -> UpsertResult (Key Bookmark)
-> SqlPersistT m (UpsertResult (Key Bookmark))
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> UpsertResult (Key Bookmark)
forall a. String -> UpsertResult a
Failed String
"unauthorized")
        Maybe Bookmark
_ -> UpsertResult (Key Bookmark)
-> SqlPersistT m (UpsertResult (Key Bookmark))
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> UpsertResult (Key Bookmark)
forall a. String -> UpsertResult a
Failed String
"not found")
    Maybe (Key Bookmark)
Nothing ->
      Unique Bookmark -> ReaderT SqlBackend m (Maybe (Entity Bookmark))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Unique record -> ReaderT SqlBackend m (Maybe (Entity record))
getBy (Key User -> Text -> Unique Bookmark
UniqueUserHref (Bookmark -> Key User
bookmarkUserId Bookmark
bm) (Bookmark -> Text
bookmarkHref Bookmark
bm)) ReaderT SqlBackend m (Maybe (Entity Bookmark))
-> (Maybe (Entity Bookmark)
    -> SqlPersistT m (UpsertResult (Key Bookmark)))
-> SqlPersistT m (UpsertResult (Key Bookmark))
forall a b.
ReaderT SqlBackend m a
-> (a -> ReaderT SqlBackend m b) -> ReaderT SqlBackend m b
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)
_ -> Key Bookmark -> UpsertResult (Key Bookmark)
forall a. a -> UpsertResult a
Created (Key Bookmark -> UpsertResult (Key Bookmark))
-> ReaderT SqlBackend m (Key Bookmark)
-> SqlPersistT m (UpsertResult (Key Bookmark))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bookmark -> ReaderT SqlBackend m (Key Bookmark)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Key record)
insert Bookmark
bm
  Maybe (Key Bookmark)
-> (Element (Maybe (Key Bookmark)) -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
mono -> (Element mono -> m ()) -> m ()
forM_ (UpsertResult (Key Bookmark) -> Maybe (Key Bookmark)
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)) 
  UpsertResult (Key Bookmark)
-> SqlPersistT m (UpsertResult (Key Bookmark))
forall a. a -> ReaderT SqlBackend m a
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Bookmark -> Text
bookmarkHref Bookmark
prev_bm
        then Bookmark
bm { bookmarkArchiveHref = Nothing }
        else Bookmark
bm { bookmarkArchiveHref = bookmarkArchiveHref prev_bm }
    replaceBookmark :: Key Bookmark
-> Bookmark -> SqlPersistT m (UpsertResult (Key Bookmark))
replaceBookmark Key Bookmark
bid Bookmark
prev_bm = do
      Key Bookmark -> Bookmark -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Key record -> record -> ReaderT SqlBackend m ()
replace Key Bookmark
bid (Bookmark -> Bookmark
prepareReplace Bookmark
prev_bm)
      Key Bookmark -> ReaderT SqlBackend m ()
forall {backend} {m :: * -> *}.
(BaseBackend backend ~ SqlBackend, MonadIO m,
 PersistQueryWrite backend) =>
Key Bookmark -> ReaderT backend m ()
deleteTags Key Bookmark
bid
      UpsertResult (Key Bookmark)
-> SqlPersistT m (UpsertResult (Key Bookmark))
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key Bookmark -> UpsertResult (Key Bookmark)
forall a. a -> UpsertResult a
Updated Key Bookmark
bid)
    deleteTags :: Key Bookmark -> ReaderT backend m ()
deleteTags Key Bookmark
bid =
      [Filter BookmarkTag] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField BookmarkTag (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField BookmarkTag typ
BookmarkTagBookmarkId EntityField BookmarkTag (Key Bookmark)
-> Key Bookmark -> Filter BookmarkTag
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' =
      [(Int, Text)]
-> (Element [(Int, Text)] -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall mono (f :: * -> *) b.
(MonoFoldable mono, Applicative f) =>
mono -> (Element mono -> f b) -> f ()
for_ ([Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip [Int
1 ..] [Text]
tags) ((Element [(Int, Text)] -> ReaderT SqlBackend m ())
 -> ReaderT SqlBackend m ())
-> (Element [(Int, Text)] -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$
      \(Int
i, Text
tag) -> ReaderT SqlBackend m (Key BookmarkTag) -> ReaderT SqlBackend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT SqlBackend m (Key BookmarkTag) -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m (Key BookmarkTag)
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ BookmarkTag -> ReaderT SqlBackend m (Key BookmarkTag)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Key record)
insert (BookmarkTag -> ReaderT SqlBackend m (Key BookmarkTag))
-> BookmarkTag -> ReaderT SqlBackend m (Key BookmarkTag)
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 =
  [Filter Bookmark] -> [Update Bookmark] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> [Update record] -> ReaderT backend m ()
forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlBackend) =>
[Filter record] -> [Update record] -> ReaderT SqlBackend m ()
updateWhere
  [EntityField Bookmark (Key User)
forall typ. (typ ~ Key User) => EntityField Bookmark typ
BookmarkUserId EntityField Bookmark (Key User) -> Key User -> Filter Bookmark
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. Key User
userId, EntityField Bookmark (Key Bookmark)
forall typ. (typ ~ Key Bookmark) => EntityField Bookmark typ
BookmarkId EntityField Bookmark (Key Bookmark)
-> Key Bookmark -> Filter Bookmark
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
CP.==. Key Bookmark
bid]
  [EntityField Bookmark (Maybe Text)
forall typ. (typ ~ Maybe Text) => EntityField Bookmark typ
BookmarkArchiveHref EntityField Bookmark (Maybe Text) -> Maybe Text -> Update Bookmark
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
      Key Note -> ReaderT SqlBackend m (Maybe Note)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Key record -> ReaderT SqlBackend m (Maybe record)
get Key Note
nid ReaderT SqlBackend m (Maybe Note)
-> (Maybe Note -> SqlPersistT m (UpsertResult (Key Note)))
-> SqlPersistT m (UpsertResult (Key Note))
forall a b.
ReaderT SqlBackend m a
-> (a -> ReaderT SqlBackend m b) -> ReaderT SqlBackend m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Note
note' -> do
          Bool -> ReaderT SqlBackend m () -> ReaderT SqlBackend m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key User
userId Key User -> Key User -> Bool
forall a. Eq a => a -> a -> Bool
/= Note -> Key User
noteUserId Note
note')
            (String -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"unauthorized")
          Key Note -> Note -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Key record -> record -> ReaderT SqlBackend m ()
replace Key Note
nid Note
note
          UpsertResult (Key Note) -> SqlPersistT m (UpsertResult (Key Note))
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key Note -> UpsertResult (Key Note)
forall a. a -> UpsertResult a
Updated Key Note
nid)
        Maybe Note
_ -> String -> SqlPersistT m (UpsertResult (Key Note))
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"not found"
    Maybe (Key Note)
Nothing -> do
      Key Note -> UpsertResult (Key Note)
forall a. a -> UpsertResult a
Created (Key Note -> UpsertResult (Key Note))
-> ReaderT SqlBackend m (Key Note)
-> SqlPersistT m (UpsertResult (Key Note))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Note -> ReaderT SqlBackend m (Key Note)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend 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
(Int -> FileBookmark -> ShowS)
-> (FileBookmark -> String)
-> ([FileBookmark] -> ShowS)
-> Show FileBookmark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileBookmark -> ShowS
showsPrec :: Int -> FileBookmark -> ShowS
$cshow :: FileBookmark -> String
show :: FileBookmark -> String
$cshowList :: [FileBookmark] -> ShowS
showList :: [FileBookmark] -> ShowS
Show, FileBookmark -> FileBookmark -> Bool
(FileBookmark -> FileBookmark -> Bool)
-> (FileBookmark -> FileBookmark -> Bool) -> Eq FileBookmark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileBookmark -> FileBookmark -> Bool
== :: FileBookmark -> FileBookmark -> Bool
$c/= :: FileBookmark -> FileBookmark -> Bool
/= :: FileBookmark -> FileBookmark -> Bool
Eq, Typeable, Eq FileBookmark
Eq FileBookmark =>
(FileBookmark -> FileBookmark -> Ordering)
-> (FileBookmark -> FileBookmark -> Bool)
-> (FileBookmark -> FileBookmark -> Bool)
-> (FileBookmark -> FileBookmark -> Bool)
-> (FileBookmark -> FileBookmark -> Bool)
-> (FileBookmark -> FileBookmark -> FileBookmark)
-> (FileBookmark -> FileBookmark -> FileBookmark)
-> Ord 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
$ccompare :: FileBookmark -> FileBookmark -> Ordering
compare :: FileBookmark -> FileBookmark -> Ordering
$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
>= :: FileBookmark -> FileBookmark -> Bool
$cmax :: FileBookmark -> FileBookmark -> FileBookmark
max :: FileBookmark -> FileBookmark -> FileBookmark
$cmin :: FileBookmark -> FileBookmark -> FileBookmark
min :: FileBookmark -> FileBookmark -> FileBookmark
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 (Text
 -> Text
 -> Text
 -> UTCTime
 -> Bool
 -> Bool
 -> Maybe Bool
 -> Maybe Text
 -> Text
 -> FileBookmark)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> UTCTime
      -> Bool
      -> Bool
      -> Maybe Bool
      -> Maybe Text
      -> Text
      -> FileBookmark)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"href" Parser
  (Text
   -> Text
   -> UTCTime
   -> Bool
   -> Bool
   -> Maybe Bool
   -> Maybe Text
   -> Text
   -> FileBookmark)
-> Parser Text
-> Parser
     (Text
      -> UTCTime
      -> Bool
      -> Bool
      -> Maybe Bool
      -> Maybe Text
      -> Text
      -> FileBookmark)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description" Parser
  (Text
   -> UTCTime
   -> Bool
   -> Bool
   -> Maybe Bool
   -> Maybe Text
   -> Text
   -> FileBookmark)
-> Parser Text
-> Parser
     (UTCTime
      -> Bool
      -> Bool
      -> Maybe Bool
      -> Maybe Text
      -> Text
      -> FileBookmark)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"extended" Parser
  (UTCTime
   -> Bool
   -> Bool
   -> Maybe Bool
   -> Maybe Text
   -> Text
   -> FileBookmark)
-> Parser UTCTime
-> Parser
     (Bool -> Bool -> Maybe Bool -> Maybe Text -> Text -> FileBookmark)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time" Parser
  (Bool -> Bool -> Maybe Bool -> Maybe Text -> Text -> FileBookmark)
-> Parser Bool
-> Parser
     (Bool -> Maybe Bool -> Maybe Text -> Text -> FileBookmark)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Text -> Bool
boolFromYesNo (Text -> Bool) -> Parser Text -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"shared") Parser (Bool -> Maybe Bool -> Maybe Text -> Text -> FileBookmark)
-> Parser Bool
-> Parser (Maybe Bool -> Maybe Text -> Text -> FileBookmark)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Text -> Bool
boolFromYesNo (Text -> Bool) -> Parser Text -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"toread") Parser (Maybe Bool -> Maybe Text -> Text -> FileBookmark)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> Text -> FileBookmark)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"selected") Parser (Maybe Text -> Text -> FileBookmark)
-> Parser (Maybe Text) -> Parser (Text -> FileBookmark)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"archive_url") Parser (Text -> FileBookmark) -> Parser Text -> Parser FileBookmark
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tags")
  parseJSON Value
_ = String -> Parser FileBookmark
forall a. String -> Parser a
A.parseFail String
"bad parse"

instance ToJSON FileBookmark where
  toJSON :: FileBookmark -> Value
toJSON FileBookmark {Bool
Maybe Bool
Maybe Text
Text
UTCTime
fileBookmarkHref :: FileBookmark -> Text
fileBookmarkDescription :: FileBookmark -> Text
fileBookmarkExtended :: FileBookmark -> Text
fileBookmarkTime :: FileBookmark -> UTCTime
fileBookmarkShared :: FileBookmark -> Bool
fileBookmarkToRead :: FileBookmark -> Bool
fileBookmarkSelected :: FileBookmark -> Maybe Bool
fileBookmarkArchiveHref :: FileBookmark -> Maybe Text
fileBookmarkTags :: FileBookmark -> Text
fileBookmarkHref :: Text
fileBookmarkDescription :: Text
fileBookmarkExtended :: Text
fileBookmarkTime :: UTCTime
fileBookmarkShared :: Bool
fileBookmarkToRead :: Bool
fileBookmarkSelected :: Maybe Bool
fileBookmarkArchiveHref :: Maybe Text
fileBookmarkTags :: Text
..} =
    [Pair] -> Value
object
      [ Key
"href" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
fileBookmarkHref
      , Key
"description" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
fileBookmarkDescription
      , Key
"extended" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
fileBookmarkExtended
      , Key
"time" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON UTCTime
fileBookmarkTime
      , Key
"shared" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Text
boolToYesNo Bool
fileBookmarkShared)
      , Key
"toread" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Text
boolToYesNo Bool
fileBookmarkToRead)
      , Key
"selected" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Bool
fileBookmarkSelected
      , Key
"archive_url" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Text
fileBookmarkArchiveHref
      , Key
"tags" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
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
(Int -> FileNote -> ShowS)
-> (FileNote -> String) -> ([FileNote] -> ShowS) -> Show FileNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileNote -> ShowS
showsPrec :: Int -> FileNote -> ShowS
$cshow :: FileNote -> String
show :: FileNote -> String
$cshowList :: [FileNote] -> ShowS
showList :: [FileNote] -> ShowS
Show, FileNote -> FileNote -> Bool
(FileNote -> FileNote -> Bool)
-> (FileNote -> FileNote -> Bool) -> Eq FileNote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileNote -> FileNote -> Bool
== :: FileNote -> FileNote -> Bool
$c/= :: FileNote -> FileNote -> Bool
/= :: FileNote -> FileNote -> Bool
Eq, Typeable, Eq FileNote
Eq FileNote =>
(FileNote -> FileNote -> Ordering)
-> (FileNote -> FileNote -> Bool)
-> (FileNote -> FileNote -> Bool)
-> (FileNote -> FileNote -> Bool)
-> (FileNote -> FileNote -> Bool)
-> (FileNote -> FileNote -> FileNote)
-> (FileNote -> FileNote -> FileNote)
-> Ord 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
$ccompare :: FileNote -> FileNote -> Ordering
compare :: FileNote -> FileNote -> Ordering
$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
>= :: FileNote -> FileNote -> Bool
$cmax :: FileNote -> FileNote -> FileNote
max :: FileNote -> FileNote -> FileNote
$cmin :: FileNote -> FileNote -> FileNote
min :: FileNote -> FileNote -> FileNote
Ord)

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

instance ToJSON FileNote where
  toJSON :: FileNote -> Value
toJSON FileNote {Int
Text
UTCTime
fileNoteId :: FileNote -> Text
fileNoteTitle :: FileNote -> Text
fileNoteText :: FileNote -> Text
fileNoteLength :: FileNote -> Int
fileNoteCreatedAt :: FileNote -> UTCTime
fileNoteUpdatedAt :: FileNote -> UTCTime
fileNoteId :: Text
fileNoteTitle :: Text
fileNoteText :: Text
fileNoteLength :: Int
fileNoteCreatedAt :: UTCTime
fileNoteUpdatedAt :: UTCTime
..} =
    [Pair] -> Value
object
      [ Key
"id" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
fileNoteId
      , Key
"title" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
fileNoteTitle
      , Key
"text" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
fileNoteText
      , Key
"length" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
fileNoteLength
      , Key
"created_at" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (UTCTime -> String
showFileNoteTime UTCTime
fileNoteCreatedAt)
      , Key
"updated_at" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
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 = Bool -> TimeLocale -> String -> String -> m UTCTime
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 = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %T"