avoid weird override by sending db-table-shortcircuit as header
This commit is contained in:
parent
f126246a23
commit
bb4140fa3d
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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) {
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user