7 -- |Utility functions used internally in this package.
8 module Network.HTTP.Lucu.Utils
11 , parseWWWFormURLEncoded
24 import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
25 import qualified Data.Ascii as A
26 import Data.ByteString (ByteString)
27 import qualified Data.ByteString.Char8 as Strict
28 import qualified Data.ByteString.Lazy.Internal as Lazy
30 import Data.List hiding (last)
32 import qualified Data.Map as M
33 import Data.Monoid.Unicode
35 import Data.Text (Text)
36 import qualified Data.Text as T
38 import Language.Haskell.TH.Lib
39 import Language.Haskell.TH.Syntax
41 import Prelude hiding (last)
42 import Prelude.Unicode
44 -- |>>> splitBy (== ':') "ab:c:def"
46 splitBy ∷ (a → Bool) → [a] → [[a]]
47 {-# INLINEABLE splitBy #-}
49 = case break isSep src of
51 (first, _sep:rest) → first : splitBy isSep rest
53 -- |>>> quoteStr "abc"
56 -- >>> quoteStr "ab\"c"
58 quoteStr ∷ Ascii → AsciiBuilder
59 quoteStr str = A.toAsciiBuilder "\"" ⊕
60 go (A.toByteString str) (∅) ⊕
63 go ∷ Strict.ByteString → AsciiBuilder → AsciiBuilder
65 = case Strict.break (≡ '"') bs of
71 (ab ⊕ b2ab x ⊕ A.toAsciiBuilder "\\\"")
73 b2ab ∷ Strict.ByteString → AsciiBuilder
74 b2ab = A.toAsciiBuilder ∘ A.unsafeFromByteString
76 -- |>>> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
77 -- [("aaa", "bbb"), ("ccc", "ddd")]
78 parseWWWFormURLEncoded ∷ Ascii → [(ByteString, ByteString)]
79 parseWWWFormURLEncoded src
80 -- THINKME: We could gain some performance by using attoparsec
83 | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') (A.toString src)
84 let (key, value) = break (≡ '=') pairStr
86 , unescape $ case value of
91 unescape ∷ String → ByteString
92 unescape = Strict.pack ∘ unEscapeString ∘ map plusToSpace
94 plusToSpace ∷ Char → Char
98 -- |>>> splitPathInfo "http://example.com/foo/bar"
100 splitPathInfo ∷ URI → [ByteString]
102 = let reqPathStr = uriPath uri
103 reqPath = [unEscapeString x | x ← splitBy (≡ '/') reqPathStr, (¬) (null x)]
105 map Strict.pack reqPath
107 -- |>>> trim " ab c d "
109 trim ∷ String → String
110 trim = reverse ∘ f ∘ reverse ∘ f
112 f = dropWhile isSpace
114 -- |Convert a 'ByteString' to an 'Exp' representing it as a literal.
115 liftByteString ∷ ByteString → Q Exp
117 = [| Strict.pack $(litE $ stringL $ Strict.unpack bs) |]
119 -- |Convert a 'Lazy.ByteString' to an 'Exp' representing it as a
121 liftLazyByteString ∷ Lazy.ByteString → Q Exp
122 liftLazyByteString = Lazy.foldrChunks f [| Lazy.Empty |]
124 f ∷ ByteString → Q Exp → Q Exp
125 f bs e = [| Lazy.Chunk $(liftByteString bs) $e |]
127 -- |Convert an 'Ascii' to an 'Exp' representing it as a literal.
128 liftAscii ∷ Ascii → Q Exp
129 liftAscii a = [| A.unsafeFromByteString $(liftByteString $ A.toByteString a) |]
131 -- |Convert a 'CIAscii' to an 'Exp' representing it as a literal.
132 liftCIAscii ∷ CIAscii → Q Exp
133 liftCIAscii a = [| A.toCIAscii $(liftAscii $ A.fromCIAscii a) |]
135 -- |Convert a 'Text' to an 'Exp' representing it as a literal.
136 liftText ∷ Text → Q Exp
137 liftText t = [| T.pack $(litE $ stringL $ T.unpack t) |]
139 -- |Convert an arbitrary 'Map' to an 'Exp' representing it as a
140 -- literal, using a given key lifter and a value lifter.
141 liftMap ∷ Eq k ⇒ (k → Q Exp) → (v → Q Exp) → Map k v → Q Exp
142 liftMap liftK liftV m
143 | M.null m = [| M.empty |]
144 | otherwise = [| M.fromDistinctAscList $(liftPairs (M.toAscList m)) |]
146 liftPairs = listE ∘ map liftPair
147 liftPair (k, v) = tupE [liftK k, liftV v]
149 -- |Convert an 'UTCTime' to an 'Exp' representing it as a literal.
150 liftUTCTime ∷ UTCTime → Q Exp
151 liftUTCTime (UTCTime {..})
152 = [| UTCTime $(liftDay utctDay) $(liftDiffTime utctDayTime) |]
154 liftDay ∷ Day → Q Exp
155 liftDay (ModifiedJulianDay {..})
156 = [| ModifiedJulianDay $(lift toModifiedJulianDay) |]
158 liftDiffTime ∷ DiffTime → Q Exp
159 liftDiffTime dt = [| fromRational ($n % $d) ∷ DiffTime |]
162 n = lift $ numerator $ toRational dt
163 d = lift $ denominator $ toRational dt