persistent + esqueleto upgrade
This commit is contained in:
parent
55fb61d5a0
commit
c637b56d9b
6 changed files with 49 additions and 46 deletions
|
@ -72,7 +72,7 @@ main = do
|
||||||
case muser of
|
case muser of
|
||||||
Nothing -> liftIO (print (userName ++ "not found"))
|
Nothing -> liftIO (print (userName ++ "not found"))
|
||||||
Just (P.Entity uid _) -> do
|
Just (P.Entity uid _) -> do
|
||||||
P.deleteCascade uid
|
P.delete uid
|
||||||
pure () :: DB ()
|
pure () :: DB ()
|
||||||
|
|
||||||
ExportBookmarks {..} ->
|
ExportBookmarks {..} ->
|
||||||
|
|
|
@ -14,7 +14,7 @@ deleteDeleteR bid = do
|
||||||
runDB do
|
runDB do
|
||||||
let k_bid = BookmarkKey bid
|
let k_bid = BookmarkKey bid
|
||||||
_ <- requireResource userId k_bid
|
_ <- requireResource userId k_bid
|
||||||
deleteCascade k_bid
|
delete k_bid
|
||||||
return ""
|
return ""
|
||||||
|
|
||||||
postReadR :: Int64 -> Handler Html
|
postReadR :: Int64 -> Handler Html
|
||||||
|
|
|
@ -87,7 +87,7 @@ deleteDeleteNoteR nid = do
|
||||||
runDB do
|
runDB do
|
||||||
let k_nid = NoteKey nid
|
let k_nid = NoteKey nid
|
||||||
_ <- requireResource userId k_nid
|
_ <- requireResource userId k_nid
|
||||||
deleteCascade k_nid
|
delete k_nid
|
||||||
return ""
|
return ""
|
||||||
|
|
||||||
postAddNoteR :: Handler ()
|
postAddNoteR :: Handler ()
|
||||||
|
|
|
@ -6,7 +6,7 @@ import Handler.Common
|
||||||
import Import
|
import Import
|
||||||
import qualified Text.Blaze.Html5 as H
|
import qualified Text.Blaze.Html5 as H
|
||||||
import Yesod.RssFeed
|
import Yesod.RssFeed
|
||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto.Experimental as E
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
getUserR :: UserNameP -> Handler Html
|
getUserR :: UserNameP -> Handler Html
|
||||||
|
|
80
src/Model.hs
80
src/Model.hs
|
@ -11,7 +11,7 @@ import qualified Control.Monad.Combinators as PC
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
import qualified Data.Time.ISO8601 as TI
|
import qualified Data.Time.ISO8601 as TI
|
||||||
import qualified Data.Time.Clock.POSIX as TI
|
import qualified Data.Time.Clock.POSIX as TI
|
||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto.Experimental as E
|
||||||
import qualified Database.Esqueleto.Internal.Internal as E (exists, unsafeSqlFunction)
|
import qualified Database.Esqueleto.Internal.Internal as E (exists, unsafeSqlFunction)
|
||||||
import qualified Data.Time as TI
|
import qualified Data.Time as TI
|
||||||
import ClassyPrelude.Yesod hiding ((||.))
|
import ClassyPrelude.Yesod hiding ((||.))
|
||||||
|
@ -21,15 +21,16 @@ import Data.Char (isSpace)
|
||||||
import Data.Either (fromRight)
|
import Data.Either (fromRight)
|
||||||
import Data.Foldable (foldl, foldl1, sequenceA_)
|
import Data.Foldable (foldl, foldl1, sequenceA_)
|
||||||
import Data.List.NonEmpty (NonEmpty(..))
|
import Data.List.NonEmpty (NonEmpty(..))
|
||||||
import Database.Esqueleto hiding ((==.))
|
import Database.Esqueleto.Experimental hiding ((==.))
|
||||||
import Pretty
|
import Pretty
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
import qualified Data.Map.Strict as MS
|
import qualified Data.Map.Strict as MS
|
||||||
|
|
||||||
import ModelCustom
|
import ModelCustom
|
||||||
|
|
||||||
share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateSchema"] [persistLowerCase|
|
share [mkPersist sqlSettings, mkMigrate "migrateSchema"] [persistLowerCase|
|
||||||
User json
|
User json
|
||||||
Id Int64
|
Id Int64
|
||||||
name Text
|
name Text
|
||||||
|
@ -43,7 +44,7 @@ User json
|
||||||
|
|
||||||
Bookmark json
|
Bookmark json
|
||||||
Id Int64
|
Id Int64
|
||||||
userId UserId
|
userId UserId OnDeleteCascade
|
||||||
slug BmSlug default="(lower(hex(randomblob(6))))"
|
slug BmSlug default="(lower(hex(randomblob(6))))"
|
||||||
href Text
|
href Text
|
||||||
description Text
|
description Text
|
||||||
|
@ -59,9 +60,9 @@ Bookmark json
|
||||||
|
|
||||||
BookmarkTag json
|
BookmarkTag json
|
||||||
Id Int64
|
Id Int64
|
||||||
userId UserId
|
userId UserId OnDeleteCascade
|
||||||
tag Text
|
tag Text
|
||||||
bookmarkId BookmarkId
|
bookmarkId BookmarkId OnDeleteCascade
|
||||||
seq Int
|
seq Int
|
||||||
UniqueUserTagBookmarkId userId tag bookmarkId
|
UniqueUserTagBookmarkId userId tag bookmarkId
|
||||||
UniqueUserBookmarkIdTagSeq userId bookmarkId tag seq
|
UniqueUserBookmarkIdTagSeq userId bookmarkId tag seq
|
||||||
|
@ -69,7 +70,7 @@ BookmarkTag json
|
||||||
|
|
||||||
Note json
|
Note json
|
||||||
Id Int64
|
Id Int64
|
||||||
userId UserId
|
userId UserId OnDeleteCascade
|
||||||
slug NtSlug default="(lower(hex(randomblob(10))))"
|
slug NtSlug default="(lower(hex(randomblob(10))))"
|
||||||
length Int
|
length Int
|
||||||
title Text
|
title Text
|
||||||
|
@ -172,13 +173,13 @@ bookmarksQuery
|
||||||
bookmarksQuery userId sharedp filterp tags mquery limit' page =
|
bookmarksQuery userId sharedp filterp tags mquery limit' page =
|
||||||
(,) -- total count
|
(,) -- total count
|
||||||
<$> fmap (sum . fmap E.unValue)
|
<$> fmap (sum . fmap E.unValue)
|
||||||
(select $
|
(select $ do
|
||||||
from \b -> do
|
b <- from $ table @Bookmark
|
||||||
_whereClause b
|
_whereClause b
|
||||||
pure E.countRows)
|
pure E.countRows)
|
||||||
-- paged data
|
-- paged data
|
||||||
<*> (select $
|
<*> (select $ do
|
||||||
from \b -> do
|
b <- from $ table @Bookmark
|
||||||
_whereClause b
|
_whereClause b
|
||||||
orderBy [desc (b ^. BookmarkTime)]
|
orderBy [desc (b ^. BookmarkTime)]
|
||||||
limit limit'
|
limit limit'
|
||||||
|
@ -189,7 +190,7 @@ bookmarksQuery userId sharedp filterp tags mquery limit' page =
|
||||||
where_ $
|
where_ $
|
||||||
foldl (\expr tag ->
|
foldl (\expr tag ->
|
||||||
expr &&. (E.exists $ -- each tag becomes an exists constraint
|
expr &&. (E.exists $ -- each tag becomes an exists constraint
|
||||||
from \t ->
|
from (table @BookmarkTag) >>= \t ->
|
||||||
where_ (t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId &&.
|
where_ (t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId &&.
|
||||||
(t ^. BookmarkTagTag `E.like` val tag))))
|
(t ^. BookmarkTagTag `E.like` val tag))))
|
||||||
(b ^. BookmarkUserId E.==. val userId)
|
(b ^. BookmarkUserId E.==. val userId)
|
||||||
|
@ -203,8 +204,8 @@ bookmarksQuery userId sharedp filterp tags mquery limit' page =
|
||||||
FilterUnread -> where_ (b ^. BookmarkToRead E.==. val True)
|
FilterUnread -> where_ (b ^. BookmarkToRead E.==. val True)
|
||||||
FilterStarred -> where_ (b ^. BookmarkSelected E.==. val True)
|
FilterStarred -> where_ (b ^. BookmarkSelected E.==. val True)
|
||||||
FilterSingle slug -> where_ (b ^. BookmarkSlug E.==. val slug)
|
FilterSingle slug -> where_ (b ^. BookmarkSlug E.==. val slug)
|
||||||
FilterUntagged -> where_ $ notExists $ from (\t -> where_ $
|
FilterUntagged -> where_ $ notExists $ from (table @BookmarkTag) >>= \t -> where_ $
|
||||||
(t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId))
|
t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId
|
||||||
-- search
|
-- search
|
||||||
sequenceA_ (parseSearchQuery (toLikeExpr b) =<< mquery)
|
sequenceA_ (parseSearchQuery (toLikeExpr b) =<< mquery)
|
||||||
|
|
||||||
|
@ -217,17 +218,18 @@ bookmarksQuery userId sharedp filterp tags mquery limit' page =
|
||||||
(toLikeB BookmarkHref term) ||.
|
(toLikeB BookmarkHref term) ||.
|
||||||
(toLikeB BookmarkDescription term) ||.
|
(toLikeB BookmarkDescription term) ||.
|
||||||
(toLikeB BookmarkExtended term) ||.
|
(toLikeB BookmarkExtended term) ||.
|
||||||
(E.exists $ from (\t -> where_ $
|
(E.exists $ from (table @BookmarkTag) >>= \t -> where_ $
|
||||||
(t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId) &&.
|
(t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId) &&.
|
||||||
(t ^. BookmarkTagTag `E.like` (wild term))))
|
(t ^. BookmarkTagTag `E.like` (wild term))
|
||||||
|
)
|
||||||
p_onefield = p_url <|> p_title <|> p_description <|> p_tags <|> p_after <|> p_before
|
p_onefield = p_url <|> p_title <|> p_description <|> p_tags <|> p_after <|> p_before
|
||||||
where
|
where
|
||||||
p_url = "url:" *> fmap (toLikeB BookmarkHref) P.takeText
|
p_url = "url:" *> fmap (toLikeB BookmarkHref) P.takeText
|
||||||
p_title = "title:" *> fmap (toLikeB BookmarkDescription) P.takeText
|
p_title = "title:" *> fmap (toLikeB BookmarkDescription) P.takeText
|
||||||
p_description = "description:" *> fmap (toLikeB BookmarkExtended) P.takeText
|
p_description = "description:" *> fmap (toLikeB BookmarkExtended) P.takeText
|
||||||
p_tags = "tags:" *> fmap (\term' -> E.exists $ from (\t -> where_ $
|
p_tags = "tags:" *> fmap (\term' -> E.exists $ from (table @BookmarkTag) >>= \t -> where_ $
|
||||||
(t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId) &&.
|
(t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId) &&.
|
||||||
(t ^. BookmarkTagTag `E.like` wild term'))) P.takeText
|
(t ^. BookmarkTagTag `E.like` wild term')) P.takeText
|
||||||
p_after = "after:" *> fmap ((b ^. BookmarkTime E.>=.) . val) (parseTimeText =<< P.takeText)
|
p_after = "after:" *> fmap ((b ^. BookmarkTime E.>=.) . val) (parseTimeText =<< P.takeText)
|
||||||
p_before = "before:" *> fmap ((b ^. BookmarkTime E.<=.) . val) (parseTimeText =<< P.takeText)
|
p_before = "before:" *> fmap ((b ^. BookmarkTime E.<=.) . val) (parseTimeText =<< P.takeText)
|
||||||
|
|
||||||
|
@ -260,8 +262,8 @@ parseTimeText t =
|
||||||
|
|
||||||
tagsQuery :: [Entity Bookmark] -> DB [Entity BookmarkTag]
|
tagsQuery :: [Entity Bookmark] -> DB [Entity BookmarkTag]
|
||||||
tagsQuery bmarks =
|
tagsQuery bmarks =
|
||||||
select $
|
select $ do
|
||||||
from \t -> do
|
t <- from (table @BookmarkTag)
|
||||||
where_ (t ^. BookmarkTagBookmarkId `in_` valList (fmap entityKey bmarks))
|
where_ (t ^. BookmarkTagBookmarkId `in_` valList (fmap entityKey bmarks))
|
||||||
orderBy [asc (t ^. BookmarkTagSeq)]
|
orderBy [asc (t ^. BookmarkTagSeq)]
|
||||||
pure t
|
pure t
|
||||||
|
@ -280,12 +282,12 @@ getNoteList :: Key User -> Maybe Text -> SharedP -> Limit -> Page -> DB (Int, [E
|
||||||
getNoteList key mquery sharedp limit' page =
|
getNoteList key mquery sharedp limit' page =
|
||||||
(,) -- total count
|
(,) -- total count
|
||||||
<$> fmap (sum . fmap E.unValue)
|
<$> fmap (sum . fmap E.unValue)
|
||||||
(select $
|
(select $ do
|
||||||
from \b -> do
|
b <- from (table @Note)
|
||||||
_whereClause b
|
_whereClause b
|
||||||
pure $ E.countRows)
|
pure $ E.countRows)
|
||||||
<*> (select $
|
<*> (select $ do
|
||||||
from \b -> do
|
b <- from (table @Note)
|
||||||
_whereClause b
|
_whereClause b
|
||||||
orderBy [desc (b ^. NoteCreated)]
|
orderBy [desc (b ^. NoteCreated)]
|
||||||
limit limit'
|
limit limit'
|
||||||
|
@ -470,16 +472,16 @@ allUserBookmarks user = do
|
||||||
where
|
where
|
||||||
bquery :: DB [Entity Bookmark]
|
bquery :: DB [Entity Bookmark]
|
||||||
bquery =
|
bquery =
|
||||||
select $
|
select $ do
|
||||||
from \b -> do
|
b <- from (table @Bookmark)
|
||||||
where_ (b ^. BookmarkUserId E.==. val user)
|
where_ (b ^. BookmarkUserId E.==. val user)
|
||||||
orderBy [asc (b ^. BookmarkTime)]
|
orderBy [asc (b ^. BookmarkTime)]
|
||||||
pure b
|
pure b
|
||||||
tquery :: DB [(Key Bookmark, Text)]
|
tquery :: DB [(Key Bookmark, Text)]
|
||||||
tquery =
|
tquery =
|
||||||
fmap (\(tid, tags) -> (E.unValue tid, E.unValue tags)) <$>
|
fmap (\(tid, tags) -> (E.unValue tid, E.unValue tags)) <$>
|
||||||
(select $
|
(select $ do
|
||||||
from \t -> do
|
t <- from (table @BookmarkTag)
|
||||||
where_ (t ^. BookmarkTagUserId E.==. val user)
|
where_ (t ^. BookmarkTagUserId E.==. val user)
|
||||||
E.groupBy (t ^. BookmarkTagBookmarkId)
|
E.groupBy (t ^. BookmarkTagBookmarkId)
|
||||||
let tags = sqlite_group_concat (t ^. BookmarkTagTag) (E.val " ")
|
let tags = sqlite_group_concat (t ^. BookmarkTagTag) (E.val " ")
|
||||||
|
@ -538,8 +540,8 @@ tagCountTop :: Key User -> Int -> DB [(Text, Int)]
|
||||||
tagCountTop user top =
|
tagCountTop user top =
|
||||||
sortOn (toLower . fst) .
|
sortOn (toLower . fst) .
|
||||||
fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$>
|
fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$>
|
||||||
( select $
|
( select $ do
|
||||||
from \t -> do
|
t <- from (table @BookmarkTag)
|
||||||
where_ (t ^. BookmarkTagUserId E.==. val user)
|
where_ (t ^. BookmarkTagUserId E.==. val user)
|
||||||
E.groupBy (E.lower_ $ t ^. BookmarkTagTag)
|
E.groupBy (E.lower_ $ t ^. BookmarkTagTag)
|
||||||
let countRows' = E.countRows
|
let countRows' = E.countRows
|
||||||
|
@ -551,8 +553,8 @@ tagCountTop user top =
|
||||||
tagCountLowerBound :: Key User -> Int -> DB [(Text, Int)]
|
tagCountLowerBound :: Key User -> Int -> DB [(Text, Int)]
|
||||||
tagCountLowerBound user lowerBound =
|
tagCountLowerBound user lowerBound =
|
||||||
fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$>
|
fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$>
|
||||||
( select $
|
( select $ do
|
||||||
from \t -> do
|
t <- from (table @BookmarkTag)
|
||||||
where_ (t ^. BookmarkTagUserId E.==. val user)
|
where_ (t ^. BookmarkTagUserId E.==. val user)
|
||||||
E.groupBy (E.lower_ $ t ^. BookmarkTagTag)
|
E.groupBy (E.lower_ $ t ^. BookmarkTagTag)
|
||||||
let countRows' = E.countRows
|
let countRows' = E.countRows
|
||||||
|
@ -564,12 +566,12 @@ tagCountLowerBound user lowerBound =
|
||||||
tagCountRelated :: Key User -> [Tag] -> DB [(Text, Int)]
|
tagCountRelated :: Key User -> [Tag] -> DB [(Text, Int)]
|
||||||
tagCountRelated user tags =
|
tagCountRelated user tags =
|
||||||
fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$>
|
fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$>
|
||||||
( select $
|
( select $ do
|
||||||
from \t -> do
|
t <- from (table @BookmarkTag)
|
||||||
where_ $
|
where_ $
|
||||||
foldl (\expr tag ->
|
foldl (\expr tag ->
|
||||||
expr &&. (E.exists $
|
expr &&. (E.exists $ do
|
||||||
from \u ->
|
u <- from (table @BookmarkTag)
|
||||||
where_ (u ^. BookmarkTagBookmarkId E.==. t ^. BookmarkTagBookmarkId &&.
|
where_ (u ^. BookmarkTagBookmarkId E.==. t ^. BookmarkTagBookmarkId &&.
|
||||||
(u ^. BookmarkTagTag `E.like` val tag))))
|
(u ^. BookmarkTagTag `E.like` val tag))))
|
||||||
(t ^. BookmarkTagUserId E.==. val user)
|
(t ^. BookmarkTagUserId E.==. val user)
|
||||||
|
|
|
@ -10,7 +10,7 @@ module TestImport
|
||||||
import Application (makeFoundation, makeLogWare)
|
import Application (makeFoundation, makeLogWare)
|
||||||
import ClassyPrelude as X hiding (delete, deleteBy, Handler)
|
import ClassyPrelude as X hiding (delete, deleteBy, Handler)
|
||||||
import Database.Persist as X hiding (get)
|
import Database.Persist as X hiding (get)
|
||||||
import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool, rawExecute, rawSql, unSingle, connEscapeName)
|
import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool, rawExecute, rawSql, unSingle)
|
||||||
import Foundation as X
|
import Foundation as X
|
||||||
import Model as X
|
import Model as X
|
||||||
import Test.Hspec as X
|
import Test.Hspec as X
|
||||||
|
@ -62,8 +62,9 @@ wipeDB app = do
|
||||||
|
|
||||||
flip runSqlPersistMPool pool $ do
|
flip runSqlPersistMPool pool $ do
|
||||||
tables <- getTables
|
tables <- getTables
|
||||||
sqlBackend <- ask
|
-- sqlBackend <- ask
|
||||||
let queries = map (\t -> "DELETE FROM " ++ (connEscapeName sqlBackend $ DBName t)) tables
|
-- let queries = map (\t -> "DELETE FROM " ++ (connEscapeName sqlBackend $ DBName t)) tables
|
||||||
|
let queries = map (\t -> "DELETE FROM " ++ t) tables
|
||||||
forM_ queries (\q -> rawExecute q [])
|
forM_ queries (\q -> rawExecute q [])
|
||||||
|
|
||||||
getTables :: DB [Text]
|
getTables :: DB [Text]
|
||||||
|
|
Loading…
Reference in a new issue