Files
postgrest/src/PostgREST/RangeQuery.hs
T
Diogo BiazusandJoe Nelson df6cbc4afa Protolude second movement (#677)
* Replace Prelude import for Protolude in middleware

* Remove qualifier from Text type

* Replace Prelude for Protolude, replace 'cs' for 'toS' calls, also change some name bindings

* Replace Prelude in main for Protolude. Replace error calls for panic calls. Also replace cs for toS

* Replace Prelude for Protolude

* Replace Prelude for Protolude in OpenAPI
2016-07-23 12:20:36 -07:00

72 lines
1.9 KiB
Haskell

module PostgREST.RangeQuery (
rangeParse
, rangeRequested
, rangeLimit
, rangeOffset
, restrictRange
, rangeGeq
, allRange
, NonnegRange
) where
import Control.Applicative
import Network.HTTP.Types.Header
import qualified Data.ByteString.Char8 as BS
import Data.Ranged.Boundaries
import Data.Ranged.Ranges
import Text.Regex.TDFA ((=~))
import Data.List (lookup)
import Protolude
type NonnegRange = Range Integer
rangeParse :: BS.ByteString -> NonnegRange
rangeParse range = do
let rangeRegex = "^([0-9]+)-([0-9]*)$" :: BS.ByteString
case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of
Just parsedRange ->
let [_, mLower, mUpper] = readMaybe . toS <$> parsedRange
lower = fromMaybe emptyRange (rangeGeq <$> mLower)
upper = fromMaybe allRange (rangeLeq <$> mUpper) in
rangeIntersection lower upper
Nothing -> allRange
rangeRequested :: RequestHeaders -> NonnegRange
rangeRequested headers = fromMaybe allRange $
rangeParse <$> lookup hRange headers
restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange
restrictRange Nothing r = r
restrictRange (Just limit) r =
rangeIntersection r $
Range BoundaryBelowAll (BoundaryAbove $ rangeOffset r + limit - 1)
rangeLimit :: NonnegRange -> Maybe Integer
rangeLimit range =
case [rangeLower range, rangeUpper range] of
[BoundaryBelow lower, BoundaryAbove upper] -> Just (1 + upper - lower)
_ -> Nothing
rangeOffset :: NonnegRange -> Integer
rangeOffset range =
case rangeLower range of
BoundaryBelow lower -> lower
_ -> panic "range without lower bound" -- should never happen
rangeGeq :: Integer -> NonnegRange
rangeGeq n =
Range (BoundaryBelow n) BoundaryAboveAll
allRange :: NonnegRange
allRange = rangeGeq 0
rangeLeq :: Integer -> NonnegRange
rangeLeq n =
Range BoundaryBelowAll (BoundaryAbove n)