persistent + esqueleto upgrade

app/migration/Main.hs

@@ -72,7 +72,7 @@ main = do
         case muser of
           Nothing -> liftIO (print (userName ++ "not found"))
           Just (P.Entity uid _) -> do
-            P.deleteCascade uid
+            P.delete uid
             pure () :: DB ()
 
     ExportBookmarks {..} ->

src/Handler/Edit.hs

@@ -14,7 +14,7 @@ deleteDeleteR bid = do
   runDB do
     let k_bid = BookmarkKey bid
     _ <- requireResource userId k_bid
-    deleteCascade k_bid
+    delete k_bid
   return ""
 
 postReadR :: Int64 -> Handler Html

src/Handler/Notes.hs

@@ -87,7 +87,7 @@ deleteDeleteNoteR nid = do
   runDB do
     let k_nid = NoteKey nid
     _ <- requireResource userId k_nid
-    deleteCascade k_nid
+    delete k_nid
   return ""
 
 postAddNoteR :: Handler ()

src/Handler/User.hs

@@ -6,7 +6,7 @@ import           Handler.Common
 import           Import
 import qualified Text.Blaze.Html5 as H
 import           Yesod.RssFeed
-import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Experimental as E
 import qualified Data.Map as Map
 
 getUserR :: UserNameP -> Handler Html

src/Model.hs

@@ -11,7 +11,7 @@ import qualified Control.Monad.Combinators as PC
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Time.ISO8601 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 Data.Time as TI
 import ClassyPrelude.Yesod hiding ((||.))
@@ -21,15 +21,16 @@ import Data.Char (isSpace)
 import Data.Either (fromRight)
 import Data.Foldable (foldl, foldl1, sequenceA_)
 import Data.List.NonEmpty (NonEmpty(..))
-import Database.Esqueleto hiding ((==.))
+import Database.Esqueleto.Experimental hiding ((==.))
 import Pretty
 import System.Directory
 import Types
+
 import qualified Data.Map.Strict as MS
 
 import ModelCustom
 
-share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateSchema"] [persistLowerCase|
+share [mkPersist sqlSettings, mkMigrate "migrateSchema"] [persistLowerCase|
 User json
   Id Int64
   name Text
@@ -43,7 +44,7 @@ User json
 
 Bookmark json
   Id Int64
-  userId UserId
+  userId UserId OnDeleteCascade
   slug BmSlug default="(lower(hex(randomblob(6))))"
   href Text
   description Text
@@ -59,9 +60,9 @@ Bookmark json
 
 BookmarkTag json
   Id Int64
-  userId UserId
+  userId UserId OnDeleteCascade
   tag Text
-  bookmarkId BookmarkId
+  bookmarkId BookmarkId OnDeleteCascade
   seq Int
   UniqueUserTagBookmarkId userId tag bookmarkId
   UniqueUserBookmarkIdTagSeq userId bookmarkId tag seq
@@ -69,7 +70,7 @@ BookmarkTag json
 
 Note json
   Id Int64
-  userId UserId
+  userId UserId  OnDeleteCascade
   slug NtSlug default="(lower(hex(randomblob(10))))"
   length Int
   title Text
@@ -172,13 +173,13 @@ bookmarksQuery
 bookmarksQuery userId sharedp filterp tags mquery limit' page =
   (,) -- total count
   <$> fmap (sum . fmap E.unValue)
-      (select $
+      (select $ do
-      from \b -> do
+       b <- from $ table @Bookmark
        _whereClause b
        pure E.countRows)
       -- paged data
-  <*> (select $
+  <*> (select $ do
-       from \b -> do
+       b <- from $ table @Bookmark
        _whereClause b
        orderBy [desc (b ^. BookmarkTime)]
        limit limit'
@@ -189,7 +190,7 @@ bookmarksQuery userId sharedp filterp tags mquery limit' page =
       where_ $
         foldl (\expr tag ->
                 expr &&. (E.exists $   -- each tag becomes an exists constraint
-                          from \t ->
+                          from (table @BookmarkTag) >>= \t ->
                           where_ (t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId &&.
                                  (t ^. BookmarkTagTag `E.like` val tag))))
           (b ^. BookmarkUserId E.==. val userId)
@@ -203,8 +204,8 @@ bookmarksQuery userId sharedp filterp tags mquery limit' page =
         FilterUnread -> where_ (b ^. BookmarkToRead E.==. val True)
         FilterStarred -> where_ (b ^. BookmarkSelected E.==. val True)
         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
       sequenceA_ (parseSearchQuery (toLikeExpr b) =<< mquery)
 
@@ -217,17 +218,18 @@ bookmarksQuery userId sharedp filterp tags mquery limit' page =
           (toLikeB BookmarkHref term) ||.
           (toLikeB BookmarkDescription term) ||.
           (toLikeB BookmarkExtended term) ||.
-          (E.exists $ from (\t -> where_ $
+          (E.exists $ from (table @BookmarkTag) >>= \t -> where_ $
                (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
           where
             p_url = "url:" *> fmap (toLikeB BookmarkHref) P.takeText
             p_title = "title:" *> fmap (toLikeB BookmarkDescription) 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 ^. 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_before = "before:" *> fmap ((b ^. BookmarkTime E.<=.) . val) (parseTimeText =<< P.takeText)
 
@@ -260,8 +262,8 @@ parseTimeText t =
 
 tagsQuery :: [Entity Bookmark] -> DB [Entity BookmarkTag]
 tagsQuery bmarks =
-  select $
+  select $ do
-  from \t -> do
+  t <- from (table @BookmarkTag)
   where_ (t ^. BookmarkTagBookmarkId `in_` valList (fmap entityKey bmarks))
   orderBy [asc (t ^. BookmarkTagSeq)]
   pure t
@@ -280,12 +282,12 @@ getNoteList :: Key User -> Maybe Text -> SharedP -> Limit -> Page -> DB (Int, [E
 getNoteList key mquery sharedp limit' page =
   (,) -- total count
   <$> fmap (sum . fmap E.unValue)
-      (select $
+      (select $ do
-      from \b -> do
+      b <- from (table @Note)
       _whereClause b
       pure $ E.countRows)
-  <*> (select $
+  <*> (select $ do
-       from \b -> do
+       b <- from (table @Note)
        _whereClause b
        orderBy [desc (b ^. NoteCreated)]
        limit limit'
@@ -470,16 +472,16 @@ allUserBookmarks user = do
   where
     bquery :: DB [Entity Bookmark]
     bquery =
-      select $
+      select $ do
-      from \b -> do
+        b <- from (table @Bookmark)
         where_ (b ^. BookmarkUserId E.==. val user)
         orderBy [asc (b ^. BookmarkTime)]
         pure b
     tquery :: DB [(Key Bookmark, Text)]
     tquery =
       fmap (\(tid, tags) -> (E.unValue tid, E.unValue tags)) <$>
-      (select $
+      (select $ do
-       from \t -> do
+         t <- from (table @BookmarkTag)
          where_ (t ^. BookmarkTagUserId E.==. val user)
          E.groupBy (t ^. BookmarkTagBookmarkId)
          let tags = sqlite_group_concat (t ^. BookmarkTagTag) (E.val " ")
@@ -538,8 +540,8 @@ tagCountTop :: Key User -> Int -> DB [(Text, Int)]
 tagCountTop user top = 
     sortOn (toLower . fst) .
     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)
       E.groupBy (E.lower_ $ t ^. BookmarkTagTag)
       let countRows' = E.countRows
@@ -551,8 +553,8 @@ tagCountTop user top =
 tagCountLowerBound :: Key User -> Int -> DB [(Text, Int)]
 tagCountLowerBound user lowerBound = 
     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)
       E.groupBy (E.lower_ $ t ^. BookmarkTagTag)
       let countRows' = E.countRows
@@ -564,12 +566,12 @@ tagCountLowerBound user lowerBound =
 tagCountRelated :: Key User -> [Tag] -> DB [(Text, Int)]
 tagCountRelated user tags = 
     fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$>
-    ( select $
+    ( select $ do
-      from \t -> do
+      t <- from (table @BookmarkTag)
       where_ $
         foldl (\expr tag ->
-                expr &&. (E.exists $
+                expr &&. (E.exists $ do
-                          from \u ->
+                          u <- from (table @BookmarkTag)
                           where_ (u ^. BookmarkTagBookmarkId E.==. t ^. BookmarkTagBookmarkId &&.
                                  (u ^. BookmarkTagTag `E.like` val tag))))
           (t ^. BookmarkTagUserId E.==. val user)

test/TestImport.hs

@@ -10,7 +10,7 @@ module TestImport
 import Application           (makeFoundation, makeLogWare)
 import ClassyPrelude         as X hiding (delete, deleteBy, Handler)
 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 Model                 as X
 import Test.Hspec            as X
@@ -62,8 +62,9 @@ wipeDB app = do
 
     flip runSqlPersistMPool pool $ do
         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 [])
 
 getTables :: DB [Text]