Skip to content
Snippets Groups Projects
Verified Commit 678279bd authored by jan.hamal.dvorak's avatar jan.hamal.dvorak
Browse files

Get rid of ICU dependency

parent 80caa889
Branches
No related tags found
No related merge requests found
...@@ -84,7 +84,6 @@ common common ...@@ -84,7 +84,6 @@ common common
, resourcet >=1.2 && <1.3 , resourcet >=1.2 && <1.3
, string-conversions >=0.4 && <0.5 , string-conversions >=0.4 && <0.5
, text >=1.2 && <1.3 , text >=1.2 && <1.3
, text-icu >=0.7 && <0.8
, time >=1.9 && <1.12 , time >=1.9 && <1.12
, wai >=3.2 && <3.3 , wai >=3.2 && <3.3
, wai-extra >=3.0 && <3.2 , wai-extra >=3.0 && <3.2
...@@ -114,6 +113,9 @@ library ...@@ -114,6 +113,9 @@ library
other-modules: other-modules:
Paths_hikaru Paths_hikaru
ghc-options:
-Wunused-packages
test-suite spec test-suite spec
import: common import: common
......
...@@ -17,6 +17,7 @@ module Hikaru.Media ...@@ -17,6 +17,7 @@ module Hikaru.Media
-- * Parsing -- * Parsing
, parseMedia , parseMedia
, pMediaList
-- * Matching -- * Matching
, matchMedia , matchMedia
...@@ -24,11 +25,13 @@ module Hikaru.Media ...@@ -24,11 +25,13 @@ module Hikaru.Media
, selectMedia , selectMedia
) )
where where
import Relude hiding (group, find, head) import Relude hiding (head, get, many)
import Relude.Unsafe (head) import Relude.Unsafe (head)
import Text.ParserCombinators.ReadP
import Data.String.Conversions import Data.String.Conversions
import Data.Text.ICU import Data.Text (toLower)
import Data.List (lookup)
import Data.Char (isControl, isSpace)
-- | -- |
...@@ -41,6 +44,7 @@ where ...@@ -41,6 +44,7 @@ where
= Media = Media
{ mediaMainType :: Text { mediaMainType :: Text
, mediaSubType :: Text , mediaSubType :: Text
, mediaParams :: [(Text, Text)]
, mediaQuality :: Float , mediaQuality :: Float
} }
deriving (Show, Eq, Ord) deriving (Show, Eq, Ord)
...@@ -65,19 +69,48 @@ where ...@@ -65,19 +69,48 @@ where
-- ] -- ]
-- --
parseMedia :: Text -> [Media] parseMedia :: Text -> [Media]
parseMedia = sortWith (negate . mediaQuality) parseMedia text = case readP_to_S pMediaList (cs (toLower text)) of
. mapMaybe build (m, ""):_ -> sortWith (negate . mediaQuality) m
. mapMaybe (group 0) _else -> []
. findAll reMedia
-- |
-- Parser for the media list coded mostly to the RFC 2045.
-- Input is always lowercased and unicode is accepted.
--
pMediaList :: ReadP [Media]
pMediaList = sepBy pMedia pSeparator <* eof
where where
build :: Text -> Maybe Media pMedia = do
build t = do mediaMainType <- cs <$> pToken
match <- find reParts t _ <- char '/'
main <- group 1 match mediaSubType <- cs <$> pToken
sub <- group 2 match mediaParams <- many pParameter
q <- (readMaybe =<< cs <$> group 3 match) <|> Just 1.0
let mediaQuality = fromMaybe 1.0 do
q <- lookup "q" mediaParams
readMaybe (cs q)
return Media{..}
pParameter = do
_ <- pSpaced $ char ';'
name <- cs <$> pToken
_ <- pSpaced $ char '='
value <- cs <$> pValue
return (name, value)
pSeparator = pSpaced $ char ','
pToken = pSpaced $ many1 (satisfy (not . quote))
pValue = pToken <++ pQuotedStr
pQuotedStr = pSpaced $ pQuoted $ many (pExcept '\\')
return $ Media main sub q pExcept c = satisfy (c /=)
pSpaced p = skipSpaces *> p <* skipSpaces
pQuoted p = char '"' *> p <* char '"'
quote c = isControl c || isSpace c || c `elem` specials
specials = "()<>@,;:\\\"/[]?=" :: [Char]
-- | -- |
...@@ -135,18 +168,4 @@ where ...@@ -135,18 +168,4 @@ where
prod = [(l, r) | l <- ls, r <- rs] prod = [(l, r) | l <- ls, r <- rs]
-- |
-- Used to split text into individual media elements.
--
reMedia :: Regex
reMedia = "(?:[^,]|\"(?:[^\"]|\\\")*\")+"
-- |
-- Used to split media element into its individual components.
--
reParts :: Regex
reParts = "([[:alnum:]!#$%&'*+.^_`|~-]+)(?:\\s*/\\s*([[:alnum:]!#$%&'*+.^_`|~-]+))?(?:.*;q\\s*=\\s*([0-9.]+))?"
-- vim:set ft=haskell sw=2 ts=2 et: -- vim:set ft=haskell sw=2 ts=2 et:
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment