6 -- |Utility functions used internally in the Lucu httpd. These
7 -- functions may be useful too for something else.
8 module Network.HTTP.Lucu.Utils
11 , parseWWWFormURLEncoded
20 import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
21 import qualified Data.Ascii as A
22 import Data.ByteString (ByteString)
23 import qualified Data.ByteString.Char8 as BS
25 import Data.List hiding (last)
27 import qualified Data.Map as M
28 import Data.Monoid.Unicode
29 import Data.Text (Text)
30 import qualified Data.Text as T
31 import Language.Haskell.TH.Lib
32 import Language.Haskell.TH.Syntax
34 import Prelude hiding (last)
35 import Prelude.Unicode
37 -- |>>> splitBy (== ':') "ab:c:def"
39 splitBy ∷ (a → Bool) → [a] → [[a]]
40 {-# INLINEABLE splitBy #-}
42 = case break isSep src of
44 (first, _sep:rest) → first : splitBy isSep rest
46 -- |>>> quoteStr "abc"
49 -- >>> quoteStr "ab\"c"
51 quoteStr ∷ Ascii → AsciiBuilder
52 quoteStr str = A.toAsciiBuilder "\"" ⊕
53 go (A.toByteString str) (∅) ⊕
56 go ∷ BS.ByteString → AsciiBuilder → AsciiBuilder
58 = case BS.break (≡ '"') bs of
60 | BS.null y → ab ⊕ b2ab x
61 | otherwise → go (BS.tail y) (ab ⊕ b2ab x
62 ⊕ A.toAsciiBuilder "\\\"")
64 b2ab ∷ BS.ByteString → AsciiBuilder
65 b2ab = A.toAsciiBuilder ∘ A.unsafeFromByteString
67 -- |>>> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
68 -- [("aaa", "bbb"), ("ccc", "ddd")]
69 parseWWWFormURLEncoded ∷ Ascii → [(ByteString, ByteString)]
70 parseWWWFormURLEncoded src
71 -- THINKME: We could gain some performance by using attoparsec
74 | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') (A.toString src)
75 let (key, value) = break (≡ '=') pairStr
77 , unescape $ case value of
82 unescape ∷ String → ByteString
83 unescape = BS.pack ∘ unEscapeString ∘ map plusToSpace
85 plusToSpace ∷ Char → Char
89 -- |>>> splitPathInfo "http://example.com/foo/bar"
91 splitPathInfo ∷ URI → [ByteString]
93 = let reqPathStr = uriPath uri
94 reqPath = [unEscapeString x | x ← splitBy (≡ '/') reqPathStr, (¬) (null x)]
98 -- |>>> trim " ab c d "
100 trim ∷ String → String
101 trim = reverse ∘ f ∘ reverse ∘ f
103 f = dropWhile isSpace
105 -- |Convert a 'CIAscii' to an 'Exp' representing it as a literal.
106 liftCIAscii ∷ CIAscii → Q Exp
107 liftCIAscii a = [| A.toCIAscii (A.unsafeFromString $(strLit a)) |]
109 strLit ∷ CIAscii → Q Exp
110 strLit = liftString ∘ A.toString ∘ A.fromCIAscii
112 -- |Convert a 'Text' to an 'Exp' representing it as a literal.
113 liftText ∷ Text → Q Exp
114 liftText t = [| T.pack $(strLit t) |]
116 strLit ∷ Text → Q Exp
117 strLit = liftString ∘ T.unpack
119 -- |Convert an arbitrary 'Map' to an 'Exp' representing it as a
120 -- literal, using a given key lifter and a value lifter.
121 liftMap ∷ Eq k ⇒ (k → Q Exp) → (v → Q Exp) → Map k v → Q Exp
122 liftMap liftK liftV m = [| M.fromAscList $(liftPairs $ M.toAscList m) |]
124 liftPairs = listE ∘ map liftPair
125 liftPair (k, v) = tupE [liftK k, liftV v]