6 -- |Utility functions used internally in this package.
7 module Network.HTTP.Lucu.Utils
15 , parseWWWFormURLEncoded
29 import Control.Applicative hiding (empty)
30 import Control.Monad hiding (mapM)
31 import Data.Ascii (Ascii, AsciiBuilder, CIAscii)
32 import qualified Data.Ascii as A
33 import Data.ByteString (ByteString)
34 import qualified Data.ByteString.Char8 as BS
35 import Data.CaseInsensitive (CI)
36 import qualified Data.CaseInsensitive as CI
38 import Data.Collections
39 import Data.Collections.BaseInstances ()
40 import Data.Convertible.Base
41 import Data.Convertible.Instances.Ascii ()
42 import Data.Convertible.Instances.Text ()
43 import Data.Convertible.Instances.Time ()
45 import Data.Monoid.Unicode
46 import Data.Text (Text)
49 import Prelude hiding (last, mapM, null, reverse)
50 import Prelude.Unicode
51 import System.Directory
53 -- |'Scheme' represents an URI scheme.
56 -- |'Host' represents an IP address or a host name in an URI
60 -- |'PathSegment' represents an URI path segment, split by slashes and
62 type PathSegment = ByteString
64 -- |'Path' is a list of URI path segments.
65 type Path = [PathSegment]
67 -- |>>> splitBy (== ':') "ab:c:def"
69 splitBy ∷ (a → Bool) → [a] → [[a]]
70 {-# INLINEABLE splitBy #-}
72 = case break isSep src of
74 (first, _sep:rest) → first : splitBy isSep rest
76 -- |>>> quoteStr "abc"
79 -- >>> quoteStr "ab\"c"
81 quoteStr ∷ Ascii → AsciiBuilder
82 quoteStr str = cs ("\"" ∷ Ascii) ⊕
86 go ∷ ByteString → AsciiBuilder → AsciiBuilder
88 = case BS.break (≡ '"') bs of
94 (ab ⊕ b2ab x ⊕ cs ("\\\"" ∷ Ascii))
96 b2ab ∷ ByteString → AsciiBuilder
97 b2ab = cs ∘ A.unsafeFromByteString
99 -- |>>> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
100 -- [("aaa", "bbb"), ("ccc", "ddd")]
101 parseWWWFormURLEncoded ∷ Ascii → [(ByteString, ByteString)]
102 parseWWWFormURLEncoded src
103 -- THINKME: We could gain some performance by using attoparsec
106 | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') (cs src)
107 let (key, value) = break (≡ '=') pairStr
108 return ( unescape key
109 , unescape $ case value of
114 unescape ∷ String → ByteString
115 unescape = BS.pack ∘ unEscapeString ∘ (plusToSpace <$>)
117 plusToSpace ∷ Char → Char
118 plusToSpace '+' = ' '
121 -- |>>> uriCIScheme "http://example.com/foo/bar"
123 uriCIScheme ∷ URI → CIAscii
124 {-# INLINE uriCIScheme #-}
125 uriCIScheme = convertUnsafe ∘ fst ∘ fromJust ∘ back ∘ uriScheme
127 -- |>>> uriHost "http://example.com/foo/bar"
130 {-# INLINE uriHost #-}
131 uriHost = CI.mk ∘ cs ∘ uriRegName ∘ fromJust ∘ uriAuthority
133 -- |>>> uriPathSegments "http://example.com/foo/bar"
135 uriPathSegments ∷ URI → Path
137 = let reqPathStr = uriPath uri
138 reqPath = [ unEscapeString x
139 | x ← splitBy (≡ '/') reqPathStr, (¬) (null x) ]
143 -- |>>> trim " ab c d "
145 trim ∷ String → String
146 trim = reverse ∘ f ∘ reverse ∘ f
148 f = dropWhile isSpace
151 -- | (⊲) = ('<|')
153 -- U+22B2, NORMAL SUBGROUP OF
154 (⊲) ∷ Sequence α a ⇒ a → α → α
158 -- | (⊳) = ('|>')
160 -- U+22B3, CONTAINS AS NORMAL SUBGROUP
161 (⊳) ∷ Sequence α a ⇒ α → a → α
165 -- | (⋈) = ('><')
168 (⋈) ∷ Sequence α a ⇒ α → α → α
171 -- |Generalised @mapM@ from any 'Foldable' to 'Unfoldable'. Why isn't
172 -- this in the @collections-api@?
173 mapM ∷ (Foldable α a, Unfoldable β b, Functor m, Monad m)
174 ⇒ (a → m b) → α → m β
176 mapM = flip foldrM empty ∘ (flip ((<$>) ∘ flip insert) ∘)
178 -- |Get the modification time of a given file.
179 getLastModified ∷ FilePath → IO UTCTime
180 getLastModified = (cs <$>) ∘ getModificationTime