avoid weird override by sending db-table-shortcircuit as header

This commit is contained in:
Gregor Kleen 2018-11-29 14:07:47 +01:00
parent f126246a23
commit bb4140fa3d
3 changed files with 7 additions and 17 deletions

View File

@ -114,7 +114,6 @@ data PaginationSettings = PaginationSettings
, psFilter :: Map (CI Text) [Text] , psFilter :: Map (CI Text) [Text]
, psLimit :: Int64 , psLimit :: Int64
, psPage :: Int64 , psPage :: Int64
, psShortcircuit :: Bool
} }
makeLenses_ ''PaginationSettings makeLenses_ ''PaginationSettings
@ -125,7 +124,6 @@ instance Default PaginationSettings where
, psFilter = Map.empty , psFilter = Map.empty
, psLimit = 50 , psLimit = 50
, psPage = 0 , psPage = 0
, psShortcircuit = False
} }
deriveJSON defaultOptions deriveJSON defaultOptions
@ -137,7 +135,6 @@ data PaginationInput = PaginationInput
, piFilter :: Maybe (Map (CI Text) [Text]) , piFilter :: Maybe (Map (CI Text) [Text])
, piLimit :: Maybe Int64 , piLimit :: Maybe Int64
, piPage :: Maybe Int64 , piPage :: Maybe Int64
, piShortcircuit :: Bool
} deriving (Eq, Ord, Show, Read, Generic) } deriving (Eq, Ord, Show, Read, Generic)
instance Default PaginationInput where instance Default PaginationInput where
@ -146,7 +143,6 @@ instance Default PaginationInput where
, piFilter = Nothing , piFilter = Nothing
, piLimit = Nothing , piLimit = Nothing
, piPage = Nothing , piPage = Nothing
, piShortcircuit = False
} }
makeLenses_ ''PaginationInput makeLenses_ ''PaginationInput
@ -161,7 +157,6 @@ piIsUnset PaginationInput{..} = and
, isNothing piFilter , isNothing piFilter
, isNothing piLimit , isNothing piLimit
, isNothing piPage , isNothing piPage
, not piShortcircuit
] ]
data DBRow r = DBRow data DBRow r = DBRow
@ -197,7 +192,6 @@ instance Default (PSValidator m x) where
Nothing -> return () Nothing -> return ()
asks piPage >>= maybe (return ()) (\p -> modify $ \ps -> ps { psPage = p }) asks piPage >>= maybe (return ()) (\p -> modify $ \ps -> ps { psPage = p })
asks piShortcircuit >>= (\s -> modify $ \ps -> ps { psShortcircuit = s })
defaultFilter :: Map (CI Text) [Text] -> PSValidator m x -> PSValidator m x defaultFilter :: Map (CI Text) [Text] -> PSValidator m x -> PSValidator m x
defaultFilter psFilter (runPSValidator -> f) = PSValidator $ \dbTable' -> injectDefault <*> f dbTable' defaultFilter psFilter (runPSValidator -> f) = PSValidator $ \dbTable' -> injectDefault <*> f dbTable'
@ -246,7 +240,7 @@ instance Default DBStyle where
data DBTable m x = forall a r r' h i t. data DBTable m x = forall a r r' h i t.
( ToSortable h, Functor h ( ToSortable h, Functor h
, E.SqlSelect a r , E.SqlSelect a r
, PathPiece i , PathPiece i, Eq i
, E.From E.SqlQuery E.SqlExpr E.SqlBackend t , E.From E.SqlQuery E.SqlExpr E.SqlBackend t
) => DBTable ) => DBTable
{ dbtSQLQuery :: t -> E.SqlQuery a { dbtSQLQuery :: t -> E.SqlQuery a
@ -365,7 +359,7 @@ instance IsDBTable m a => IsString (DBCell m a) where
dbTable :: forall m x. IsDBTable m x => PSValidator m x -> DBTable m x -> DB (DBResult m x) 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 dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> dbtIdent), dbtStyle = DBStyle{..}, .. } = do
let let
sortingOptions = mkOptionList sortingOptions = mkOptionList
[ Option t' (t, d) t' [ Option t' (t, d) t'
@ -390,15 +384,10 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = (toPathPiece -> dbtIdent), d
<*> (assertM' (not . Map.null) . Map.mapMaybe (assertM $ not . null) <$> Map.traverseWithKey (\k _ -> iopt multiTextField . wIdent $ CI.foldedCase k) dbtFilter) <*> (assertM' (not . Map.null) . Map.mapMaybe (assertM $ not . null) <$> Map.traverseWithKey (\k _ -> iopt multiTextField . wIdent $ CI.foldedCase k) dbtFilter)
<*> iopt intField (wIdent "pagesize") <*> iopt intField (wIdent "pagesize")
<*> iopt intField (wIdent "page") <*> iopt intField (wIdent "page")
<*> ireq checkBoxField (wIdent "table-only")
piPrevious <- fmap (fmap (set _piShortcircuit False) . maybe FormMissing FormSuccess) . runMaybeT $ MaybeT . return . decodeStrict' . encodeUtf8 =<< MaybeT (lookupPostParam $ wIdent "pagination") piPrevious <- fmap (maybe FormMissing FormSuccess) . runMaybeT $ MaybeT . return . decodeStrict' . encodeUtf8 =<< MaybeT (lookupPostParam $ wIdent "pagination")
$(logDebug) . tshow $ (,,,,) <$> (piSorting <$> piResult) psShortcircuit <- (== Just dbtIdent') <$> lookupCustomHeader HeaderDBTableShortcircuit
<*> (piFilter <$> piResult)
<*> (piLimit <$> piResult)
<*> (piPage <$> piResult)
<*> (piShortcircuit <$> piResult)
let let
(errs, PaginationSettings{..}) = case piPrevious <|> piResult of (errs, PaginationSettings{..}) = case piPrevious <|> piResult of

View File

@ -513,7 +513,7 @@ hasGlobalGetParam ident = isJust <$> lookupGetParam (toPathPiece ident)
-- Custom HTTP Request-Headers -- -- Custom HTTP Request-Headers --
--------------------------------- ---------------------------------
data CustomHeader = HeaderIsModal data CustomHeader = HeaderIsModal | HeaderDBTableShortcircuit
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
instance Universe CustomHeader instance Universe CustomHeader

View File

@ -54,7 +54,8 @@
fetch(url, { fetch(url, {
credentials: 'same-origin', credentials: 'same-origin',
headers: { headers: {
'Accept': 'text/html' 'Accept': 'text/html',
#{String (toPathPiece HeaderDBTableShortcircuit)}: #{String dbtIdent}
} }
}).then(function(response) { }).then(function(response) {
if (!response.ok) { if (!response.ok) {