7 -- |Utility functions used internally in the Lucu httpd. These
8 -- functions may be useful too for something else.
9 module Network.HTTP.Lucu.Utils
12 , parseWWWFormURLEncoded
25 import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
26 import qualified Data.Ascii as A
27 import Data.ByteString (ByteString)
28 import qualified Data.ByteString.Char8 as Strict
29 import qualified Data.ByteString.Unsafe as Strict
30 import qualified Data.ByteString.Lazy.Internal as Lazy
32 import Data.List hiding (last)
34 import qualified Data.Map as M
35 import Data.Monoid.Unicode
37 import Data.Text (Text)
38 import qualified Data.Text as T
40 import Language.Haskell.TH.Lib
41 import Language.Haskell.TH.Syntax
43 import Prelude hiding (last)
44 import Prelude.Unicode
45 import System.IO.Unsafe
47 -- |>>> splitBy (== ':') "ab:c:def"
49 splitBy ∷ (a → Bool) → [a] → [[a]]
50 {-# INLINEABLE splitBy #-}
52 = case break isSep src of
54 (first, _sep:rest) → first : splitBy isSep rest
56 -- |>>> quoteStr "abc"
59 -- >>> quoteStr "ab\"c"
61 quoteStr ∷ Ascii → AsciiBuilder
62 quoteStr str = A.toAsciiBuilder "\"" ⊕
63 go (A.toByteString str) (∅) ⊕
66 go ∷ Strict.ByteString → AsciiBuilder → AsciiBuilder
68 = case Strict.break (≡ '"') bs of
74 (ab ⊕ b2ab x ⊕ A.toAsciiBuilder "\\\"")
76 b2ab ∷ Strict.ByteString → AsciiBuilder
77 b2ab = A.toAsciiBuilder ∘ A.unsafeFromByteString
79 -- |>>> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
80 -- [("aaa", "bbb"), ("ccc", "ddd")]
81 parseWWWFormURLEncoded ∷ Ascii → [(ByteString, ByteString)]
82 parseWWWFormURLEncoded src
83 -- THINKME: We could gain some performance by using attoparsec
86 | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') (A.toString src)
87 let (key, value) = break (≡ '=') pairStr
89 , unescape $ case value of
94 unescape ∷ String → ByteString
95 unescape = Strict.pack ∘ unEscapeString ∘ map plusToSpace
97 plusToSpace ∷ Char → Char
101 -- |>>> splitPathInfo "http://example.com/foo/bar"
103 splitPathInfo ∷ URI → [ByteString]
105 = let reqPathStr = uriPath uri
106 reqPath = [unEscapeString x | x ← splitBy (≡ '/') reqPathStr, (¬) (null x)]
108 map Strict.pack reqPath
110 -- |>>> trim " ab c d "
112 trim ∷ String → String
113 trim = reverse ∘ f ∘ reverse ∘ f
115 f = dropWhile isSpace
117 -- |Convert a 'ByteString' to an 'Exp' representing it as a literal.
118 liftByteString ∷ ByteString → Q Exp
120 = [| Strict.pack $(litE $ stringL $ Strict.unpack bs) |]
122 -- |Convert a 'Lazy.ByteString' to an 'Exp' representing it as a
124 liftLazyByteString ∷ Lazy.ByteString → Q Exp
125 liftLazyByteString = Lazy.foldrChunks f [| Lazy.Empty |]
127 f ∷ ByteString → Q Exp → Q Exp
128 f bs e = [| Lazy.Chunk $(liftByteString bs) $e |]
130 -- |Convert an 'Ascii' to an 'Exp' representing it as a literal.
131 liftAscii ∷ Ascii → Q Exp
132 liftAscii a = [| A.unsafeFromByteString
134 $ Strict.unsafePackAddressLen $len $ptr
137 bs ∷ Strict.ByteString
138 bs = A.toByteString a
141 len = lift $ Strict.length bs
142 ptr = litE $ stringPrimL $ Strict.unpack bs
144 -- |Convert a 'CIAscii' to an 'Exp' representing it as a literal.
145 liftCIAscii ∷ CIAscii → Q Exp
146 liftCIAscii a = [| A.toCIAscii $(liftAscii $ A.fromCIAscii a) |]
148 -- |Convert a 'Text' to an 'Exp' representing it as a literal.
149 liftText ∷ Text → Q Exp
150 liftText t = [| T.pack $(litE $ stringL $ T.unpack t) |]
152 -- |Convert an arbitrary 'Map' to an 'Exp' representing it as a
153 -- literal, using a given key lifter and a value lifter.
154 liftMap ∷ Eq k ⇒ (k → Q Exp) → (v → Q Exp) → Map k v → Q Exp
155 liftMap liftK liftV m
156 | M.null m = [| M.empty |]
157 | otherwise = [| M.fromDistinctAscList $(liftPairs (M.toAscList m)) |]
159 liftPairs = listE ∘ map liftPair
160 liftPair (k, v) = tupE [liftK k, liftV v]
162 -- |Convert an 'UTCTime' to an 'Exp' representing it as a literal.
163 liftUTCTime ∷ UTCTime → Q Exp
164 liftUTCTime (UTCTime {..})
166 utctDay = $(liftDay utctDay)
167 , utctDayTime = $(liftDiffTime utctDayTime)
171 liftDay ∷ Day → Q Exp
172 liftDay (ModifiedJulianDay {..})
173 = [| ModifiedJulianDay {
174 toModifiedJulianDay = $(lift toModifiedJulianDay)
178 liftDiffTime ∷ DiffTime → Q Exp
179 liftDiffTime dt = [| fromRational ($n % $d) ∷ DiffTime |]
182 n = lift $ numerator $ toRational dt
183 d = lift $ denominator $ toRational dt