-
Notifications
You must be signed in to change notification settings - Fork 24
/
Query.purs
55 lines (47 loc) · 1.76 KB
/
Query.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
module Data.URI.Query (parser, print) where
import Prelude
import Control.Alt ((<|>))
import Data.Either (fromRight)
import Data.List (List(..))
import Data.Maybe (Maybe(..))
import Data.String as S
import Data.String.Regex as RX
import Data.String.Regex.Flags as RXF
import Data.Tuple (Tuple(..))
import Data.URI (Query(..))
import Data.URI.Common (joinWith, rxPat, wrapParser)
import Global (decodeURIComponent, encodeURIComponent)
import Partial.Unsafe (unsafePartial)
import Text.Parsing.StringParser (Parser, try)
import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy)
import Text.Parsing.StringParser.String (string)
parser ∷ Parser Query
parser = Query <$> wrapParser parseParts (try (rxPat "[^#]*"))
parseParts ∷ Parser (List (Tuple String (Maybe String)))
parseParts = sepBy parsePart (string ";" <|> string "&")
parsePart ∷ Parser (Tuple String (Maybe String))
parsePart = do
key ← decodeURIComponent <$> rxPat "[^=;&]+"
value ← optionMaybe $ decodeURIComponent <$> (string "=" *> rxPat "[^;&]*")
pure $ Tuple key value
print ∷ Query → String
print (Query m) =
case m of
Nil → "?"
items → "?" <> joinWith "&" (printPart <$> items)
where
printPart ∷ Tuple String (Maybe String) → String
printPart (Tuple k Nothing) =
printQueryPart k
printPart (Tuple k (Just v)) =
printQueryPart k <> "=" <> printQueryPart v
printQueryPart ∷ String → String
printQueryPart = S.joinWith "" <<< map printChar <<< S.split (S.Pattern "")
where
-- Fragments & queries have a bunch of characters that don't need escaping
printChar ∷ String → String
printChar s
| RX.test rxPrintable s = s
| otherwise = encodeURIComponent s
rxPrintable ∷ RX.Regex
rxPrintable = unsafePartial fromRight $ RX.regex "[$+=/?:@]" RXF.global