{- hums - The Haskell UPnP Server Copyright (C) 2009 Bardur Arantsson This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . -} module HttpExtra ( parseRangeHeader ) where import Text.ParserCombinators.Parsec parseRange :: GenParser Char a (Maybe Integer, Maybe Integer) parseRange = choice [parseFullRange, parseEndRange, parseSingleByteRange] parseFullRange :: GenParser Char a (Maybe Integer, Maybe Integer) parseFullRange = do i1 <- parseInteger _ <- char '-' i2 <- optionMaybe parseInteger return (Just i1, i2) parseEndRange :: GenParser Char a (Maybe Integer, Maybe Integer) parseEndRange = do _ <- char '-' i1 <- parseInteger return (Just $ -i1, Nothing) parseSingleByteRange :: GenParser Char a (Maybe Integer, Maybe Integer) parseSingleByteRange = do i1 <- parseInteger _ <- char '-' return (Just i1, Just i1) parseInteger :: GenParser Char a Integer parseInteger = do ds <- many1 digit return (read ds :: Integer) parseRanges :: GenParser Char a [(Maybe Integer, Maybe Integer)] parseRanges = do _ <- string "bytes=" parseRange `sepBy` char ',' parseRangeHeader :: String -> [(Maybe Integer, Maybe Integer)] parseRangeHeader s = case parse parseRanges "-" s of Left err -> [] -- Ignore if we can't parse Right rs -> rs