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 ()
41 import Data.Monoid.Unicode
43 import Data.Text (Text)
44 import qualified Data.Text as T
46 import Data.Time.Clock.POSIX
48 import Prelude hiding (last, mapM, null, reverse)
49 import Prelude.Unicode
50 import System.Directory
51 import System.Time (ClockTime(..))
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 -- |'PathSegments' is a list of URI path segments.
65 type PathSegments = [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 = A.toAsciiBuilder "\"" ⊕
83 go (A.toByteString str) (∅) ⊕
86 go ∷ ByteString → AsciiBuilder → AsciiBuilder
88 = case BS.break (≡ '"') bs of
94 (ab ⊕ b2ab x ⊕ A.toAsciiBuilder "\\\"")
96 b2ab ∷ ByteString → AsciiBuilder
97 b2ab = A.toAsciiBuilder ∘ 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 ≡ '&') (A.toString 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 → Scheme
124 {-# INLINE uriCIScheme #-}
125 uriCIScheme = A.toCIAscii ∘ A.unsafeFromString ∘ uriScheme
127 -- |>>> uriHost "http://example.com/foo/bar"
130 {-# INLINE uriHost #-}
131 uriHost = CI.mk ∘ T.pack ∘ uriRegName ∘ fromJust ∘ uriAuthority
133 -- |>>> uriPathSegments "http://example.com/foo/bar"
135 uriPathSegments ∷ URI → PathSegments
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 -- | (B2;) = ('<|')
153 -- U+22B2, NORMAL SUBGROUP OF
154 (⊲) ∷ Sequence α a ⇒ a → α → α
158 -- | (B3;) = ('|>')
160 -- U+22B3, CONTAINS AS NORMAL SUBGROUP
161 (⊳) ∷ Sequence α a ⇒ α → a → α
165 -- | (C8;) = ('><')
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 = (clockTimeToUTC <$>) ∘ getModificationTime
182 clockTimeToUTC ∷ ClockTime → UTCTime
183 clockTimeToUTC (TOD sec picoSec)
184 = posixSecondsToUTCTime ∘ fromRational
185 $ sec % 1 + picoSec % (1000 ⋅ 1000 ⋅ 1000 ⋅ 1000)