From 9879c9f0d58df6037c384c84fba5eddde09d83b9 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Thu, 24 Jan 2019 17:08:02 +0100
Subject: [PATCH] Revert "Expose runPaginationSettings'"

This reverts commit a03577f97091bd6dae6df68d5fccc61e5fd68d25.
---
 src/Handler/Utils/Table/Pagination.hs | 70 +++++++++------------------
 1 file changed, 22 insertions(+), 48 deletions(-)

diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index cefe77a89..3ef8450e0 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -17,7 +17,6 @@ module Handler.Utils.Table.Pagination
   , defaultFilter, defaultSorting
   , restrictFilter, restrictSorting
   , ToSortable(..), Sortable(..)
-  , runPaginationSettings'
   , dbTable
   , dbTableWidget, dbTableWidget'
   , widgetColonnade, formColonnade, dbColonnade
@@ -213,7 +212,6 @@ data PaginationSettings = PaginationSettings
   , psFilter       :: Map FilterKey [Text]
   , psLimit        :: PagesizeLimit
   , psPage         :: Int64
-  , psShortcircuit :: Bool
   }
 
 makeLenses_ ''PaginationSettings
@@ -224,7 +222,6 @@ instance Default PaginationSettings where
     , psFilter       = Map.empty
     , psLimit        = PagesizeLimit 50
     , psPage         = 0
-    , psShortcircuit = False
     }
 
 deriveJSON defaultOptions
@@ -557,17 +554,29 @@ instance IsDBTable m a => IsString (DBCell m a) where
   fromString = cell . fromString
 
 
-data PaginationState = PaginationState
-  { filterWdgt, pagesizeWdgt :: Widget
-  , filterEnc, pagesizeEnc :: Enctype
-  , paginationInput :: PaginationInput
-  }
+dbTable :: forall m x. IsDBTable m x => PSValidator m x -> DBTable m x -> DB (DBResult m x)
+dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> dbtIdent), dbtStyle = DBStyle{..}, .. } = do
+  let
+    sortingOptions = mkOptionList
+      [ Option t' (SortingSetting t d) t'
+      | (t, _) <- mapToList dbtSorting
+      , d <- [SortAsc, SortDesc]
+      , let t' = toPathPiece $ SortingSetting t d
+      ]
+    wIdent :: Text -> Text
+    wIdent = toPathPiece . WithIdent dbtIdent 
+    dbsAttrs'
+      | not $ null dbtIdent = ("id", dbtIdent) : dbsAttrs
+      | otherwise           = dbsAttrs
+    multiTextField = Field
+      { fieldParse = \ts _ -> return . Right $ Just ts
+      , fieldView = error "multiTextField: should not be rendered"
+      , fieldEnctype = UrlEncoded
+      }
 
-runPaginationSettings :: (MonadHandler m', HandlerSite m' ~ UniWorX) => PSValidator m x -> DBTable m x -> ReaderT (YesodPersistBackend UniWorX) m' (PaginationSettings, PaginationState)
-runPaginationSettings PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> dbtIdent), .. } = hoist liftHandlerT $ do
-  
   piPrevious <- lift . runInputMaybe $ ireq (jsonField True) (wIdent "pagination")
   let piPreviousRes = maybe FormMissing FormSuccess piPrevious
+  previousKeys <- throwExceptT . runMaybeT $ encodedSecretBoxOpen =<< MaybeT (lift . lookupPostParam $ wIdent "previous")
 
   piInput <- lift . runInputGetResult $ PaginationInput
     <$> iopt (multiSelectField $ return sortingOptions) (wIdent "sorting")
@@ -600,7 +609,7 @@ runPaginationSettings PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toP
   psShortcircuit <- (== Just dbtIdent') <$> lookupCustomHeader HeaderDBTableShortcircuit
 
   let
-    ((errs, paginationSettings), paginationInput)
+    ((errs, PaginationSettings{..}), paginationInput@PaginationInput{..})
       | FormSuccess pi <- piResult
       , not $ piIsUnset pi
       = (, pi) . runPSValidator dbtable $ Just pi
@@ -608,45 +617,10 @@ runPaginationSettings PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toP
       = (, def) . first (map SomeMessage errs' <>) $ runPSValidator dbtable Nothing
       | otherwise
       = (, def) $ runPSValidator dbtable Nothing
+    psSorting' = map (\SortingSetting{..} -> (dbtSorting ! sortKey, sortDir)) psSorting
 
   mapM_ (addMessageI Warning) errs
 
-  return (paginationSettings{ psShortcircuit }, PaginationState{..})
-  where
-    wIdent :: Text -> Text
-    wIdent = toPathPiece . WithIdent dbtIdent 
-    sortingOptions = mkOptionList
-      [ Option t' (SortingSetting t d) t'
-      | (t, _) <- mapToList dbtSorting
-      , d <- [SortAsc, SortDesc]
-      , let t' = toPathPiece $ SortingSetting t d
-      ]
-    multiTextField = Field
-      { fieldParse = \ts _ -> return . Right $ Just ts
-      , fieldView = error "multiTextField: should not be rendered"
-      , fieldEnctype = UrlEncoded
-      }
-
-runPaginationSettings' :: forall m' m x. (MonadHandler m', HandlerSite m' ~ UniWorX)
-                       => PSValidator m x -> DBTable m x -> ReaderT (YesodPersistBackend UniWorX) m' PaginationSettings
-runPaginationSettings' psValidator dbtable = fst <$> runPaginationSettings psValidator dbtable
-
-
-dbTable :: forall m x. IsDBTable m x => PSValidator m x -> DBTable m x -> DB (DBResult m x)
-dbTable psValidator dbtable@DBTable{ dbtIdent = toPathPiece -> dbtIdent, dbtStyle = DBStyle{..}, .. } = do
-  let
-    wIdent :: Text -> Text
-    wIdent = toPathPiece . WithIdent dbtIdent 
-    dbsAttrs'
-      | not $ null dbtIdent = ("id", dbtIdent) : dbsAttrs
-      | otherwise           = dbsAttrs
-
-  previousKeys <- throwExceptT . runMaybeT $ encodedSecretBoxOpen =<< MaybeT (lift . lookupPostParam $ wIdent "previous")
-
-  (PaginationSettings{..}, PaginationState{ paginationInput = paginationInput@PaginationInput{..}, .. })
-    <- runPaginationSettings psValidator dbtable
-  let psSorting' = map (\SortingSetting{..} -> (dbtSorting ! sortKey, sortDir)) psSorting
-
   rows' <- E.select . E.from $ \t -> do
     res <- dbtSQLQuery t
     E.orderBy (map (sqlSortDirection t) psSorting')