6 -- |Utility functions used internally in this package.
7 module Network.HTTP.Lucu.Utils
14 , parseWWWFormURLEncoded
27 import Control.Applicative hiding (empty)
28 import Control.Monad hiding (mapM)
29 import Data.Ascii (Ascii, AsciiBuilder)
30 import qualified Data.Ascii as A
31 import Data.ByteString (ByteString)
32 import qualified Data.ByteString.Char8 as BS
33 import Data.CaseInsensitive (CI)
34 import qualified Data.CaseInsensitive as CI
36 import Data.Collections
37 import Data.Collections.BaseInstances ()
38 import Data.Convertible.Base
39 import Data.Convertible.Instances.Ascii ()
40 import Data.Convertible.Instances.Text ()
41 import Data.Convertible.Instances.Time ()
43 import Data.Monoid.Unicode
44 import Data.Text (Text)
47 import Prelude hiding (last, mapM, null, reverse)
48 import Prelude.Unicode
49 import System.Directory
51 -- |'Host' represents an IP address or a host name in an URI
55 -- |'PathSegment' represents an URI path segment, split by slashes and
57 type PathSegment = ByteString
59 -- |'Path' is a list of URI path segments.
60 type Path = [PathSegment]
62 -- |>>> splitBy (== ':') "ab:c:def"
64 splitBy ∷ (a → Bool) → [a] → [[a]]
65 {-# INLINEABLE splitBy #-}
67 = case break isSep src of
69 (first, _sep:rest) → first : splitBy isSep rest
71 -- |>>> quoteStr "abc"
74 -- >>> quoteStr "ab\"c"
76 quoteStr ∷ Ascii → AsciiBuilder
77 quoteStr str = cs ("\"" ∷ Ascii) ⊕
81 go ∷ ByteString → AsciiBuilder → AsciiBuilder
83 = case BS.break (≡ '"') bs of
89 (ab ⊕ b2ab x ⊕ cs ("\\\"" ∷ Ascii))
91 b2ab ∷ ByteString → AsciiBuilder
92 b2ab = cs ∘ A.unsafeFromByteString
94 -- |>>> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
95 -- [("aaa", "bbb"), ("ccc", "ddd")]
96 parseWWWFormURLEncoded ∷ Ascii → [(ByteString, ByteString)]
97 parseWWWFormURLEncoded src
98 -- THINKME: We could gain some performance by using attoparsec
101 | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') (cs src)
102 let (key, value) = break (≡ '=') pairStr
103 return ( unescape key
104 , unescape $ case value of
109 unescape ∷ String → ByteString
110 unescape = BS.pack ∘ unEscapeString ∘ (plusToSpace <$>)
112 plusToSpace ∷ Char → Char
113 plusToSpace '+' = ' '
116 -- |>>> uriHost "http://example.com/foo/bar"
119 {-# INLINE uriHost #-}
120 uriHost = CI.mk ∘ cs ∘ uriRegName ∘ fromJust ∘ uriAuthority
122 -- |>>> uriPathSegments "http://example.com/foo/bar"
124 uriPathSegments ∷ URI → Path
126 = let reqPathStr = uriPath uri
127 reqPath = [ unEscapeString x
128 | x ← splitBy (≡ '/') reqPathStr, (¬) (null x) ]
132 -- |>>> trim " ab c d "
134 trim ∷ String → String
135 trim = reverse ∘ f ∘ reverse ∘ f
137 f = dropWhile isSpace
140 -- | (⊲) = ('<|')
142 -- U+22B2, NORMAL SUBGROUP OF
143 (⊲) ∷ Sequence α a ⇒ a → α → α
147 -- | (⊳) = ('|>')
149 -- U+22B3, CONTAINS AS NORMAL SUBGROUP
150 (⊳) ∷ Sequence α a ⇒ α → a → α
154 -- | (⋈) = ('><')
157 (⋈) ∷ Sequence α a ⇒ α → α → α
160 -- |Generalised @mapM@ from any 'Foldable' to 'Unfoldable'. Why isn't
161 -- this in the @collections-api@?
162 mapM ∷ (Foldable α a, Unfoldable β b, Functor m, Monad m)
163 ⇒ (a → m b) → α → m β
165 mapM = flip foldrM empty ∘ (flip ((<$>) ∘ flip insert) ∘)
167 -- |Get the modification time of a given file.
168 getLastModified ∷ FilePath → IO UTCTime
169 getLastModified = (cs <$>) ∘ getModificationTime