module Yesod.Filter.Builder where import Control.Exception (throwIO) import Data.Either (lefts, rights) import Data.Maybe (catMaybes) import Data.Text (Text) import Yesod.Core (ErrorResponse (InvalidArgs), MonadHandler, getRequest, liftIO, lookupGetParam, reqGetParams) import Yesod.Core.Types (HandlerContents (HCError)) import Yesod.Persist (Filter, SelectOpt) import Yesod.Filter.Internal (getFilters, getLimitTo, getOffsetBy, getOrderBy) import Yesod.Filter.Types buildFiltersFromGetParams :: MonadHandler m => [(Text, Text -> Maybe (Filter record))] -> Options -> m [Filter record] buildFiltersFromGetParams availableFilters options = do request <- getRequest let otherParams = sortParams (sorting options) ++ pageParams (pagination options) filterParams = filter ((`notElem` otherParams) . fst) $ reqGetParams request efilters = getFilters availableFilters filterParams case lefts efilters of [] -> pure $ rights efilters msg : _ -> liftIO $ throwIO $ HCError $ InvalidArgs [msg] where sortParams (AllowSorting sortParam' _ _) = [sortParam'] sortParams _ = [] pageParams (OffsetPagination offsetParam' _ limitParam' _) = [offsetParam', limitParam'] pageParams _ = [] buildSelectOptsFromGetParams :: MonadHandler m => Maybe (SelectOpt record) -> [(Text, SelectOpt record)] -> Options -> m [SelectOpt record] buildSelectOptsFromGetParams defaultOrderBy availableOrderBys options = do orderBy <- getOrderByFromGetParams $ sorting options offsetBy <- getOffsetByFromGetParams $ pagination options limitTo <- getLimitToFromGetParams $ pagination options pure $ catMaybes [orderBy, offsetBy, limitTo] where getOrderByFromGetParams (AllowSorting sortParam' _ _) = do msort <- lookupGetParam sortParam' case getOrderBy defaultOrderBy availableOrderBys msort of Right morderBy -> pure morderBy Left msg -> liftIO $ throwIO $ HCError $ InvalidArgs [msg] getOrderByFromGetParams _ = pure Nothing getOffsetByFromGetParams (OffsetPagination offsetParam' defaultOffset' _ _) = do moffset <- lookupGetParam offsetParam' case getOffsetBy defaultOffset' moffset of Right moffsetBy -> pure moffsetBy Left msg -> liftIO $ throwIO $ HCError $ InvalidArgs [msg] getOffsetByFromGetParams _ = pure Nothing getLimitToFromGetParams (OffsetPagination _ _ limitParam' defaultLimit') = do mlimit <- lookupGetParam limitParam' case getLimitTo defaultLimit' mlimit of Right mlimitTo -> pure mlimitTo Left msg -> liftIO $ throwIO $ HCError $ InvalidArgs [msg] getLimitToFromGetParams _ = pure Nothing