Parse range queries

Main.hs

@@ -21,10 +21,11 @@ import qualified Data.ByteString.Char8 as BS
 
 import PgStructure (printTables, printColumns)
 import PgQuery     (selectWhere)
+import RangeQuery
 
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
-import Text.Regex.Posix ((=~))
+import Text.Regex.TDFA ((=~))
 import Text.Read (readMaybe)
 
 data AppConfig = AppConfig {

PgQuery.hs

@@ -31,7 +31,6 @@ selectWhere ver table qq conn = do
           \  from (select * from %I.%I) t"
         [toSql ver, toSql table]
 
-
 whereClause :: Connection -> Query -> IO BS.ByteString
 whereClause _    [] = return ""
 whereClause conn qs =

RangeQuery.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module RangeQuery where
+
+import Control.Applicative
+import Network.HTTP.Types.Header
+
+import Data.Ranged.Boundaries
+import Data.Ranged.Ranges
+
+import qualified Data.ByteString.Char8 as BS
+import Text.Regex.TDFA ((=~))
+import Text.Read (readMaybe)
+
+import Data.Maybe (fromMaybe, listToMaybe)
+
+rangeGeq :: Int -> Range Int
+rangeGeq n =
+  head $ rangeUnion (singletonRange n) $ Range (BoundaryAbove n) BoundaryAboveAll
+
+rangeLeq :: Int -> Range Int
+rangeLeq n =
+  head $ rangeUnion (singletonRange n) $ Range BoundaryBelowAll (BoundaryBelow n)
+
+parseRange :: String -> Maybe(Range Int)
+parseRange range = do
+  let rangeRegex = "^([0-9]+)-([0-9]*)$" :: String
+
+  parsedRange <- listToMaybe (range =~ rangeRegex :: [[String]])
+
+  let [_, from, to] = readMaybe <$> parsedRange
+  let lower = fromMaybe emptyRange   (rangeGeq <$> from)
+  let upper = fromMaybe (rangeGeq 0) (rangeLeq <$> to)
+
+  return $ rangeIntersection lower upper
+
+requestedRange :: RequestHeaders -> Maybe(Range Int)
+requestedRange hdrs = parseRange =<< BS.unpack <$> lookup hRange hdrs

dbapi.cabal

@@ -15,6 +15,7 @@ executable dbapi
   ghc-options:         -Wall
   other-modules:       PgStructure
                      , PgQuery
+                     , RangeQuery
   other-extensions:    OverloadedStrings
   build-depends:       base >=4.6 && <5
                      , HDBC, HDBC-postgresql
@@ -22,6 +23,8 @@ executable dbapi
                      , bytestring, aeson, network
                      , text, optparse-applicative
                      , unordered-containers
-                     , http-media, regex-posix
+                     , regex-base
+                     , http-media, regex-tdfa
+                     , Ranged-sets
   -- hs-source-dirs:
   default-language:    Haskell2010