#-}
-- |Utility functions used internally in this package.
module Network.HTTP.Lucu.Utils
- ( splitBy
+ ( Scheme
+ , Host
+ , PathSegment
+ , PathSegments
+
+ , splitBy
, quoteStr
, parseWWWFormURLEncoded
- , splitPathInfo
+ , uriCIScheme
+ , uriHost
+ , uriPathSegments
, trim
, (⊲)
where
import Control.Applicative hiding (empty)
import Control.Monad hiding (mapM)
-import Data.Ascii (Ascii, AsciiBuilder)
+import Data.Ascii (Ascii, AsciiBuilder, CIAscii)
import qualified Data.Ascii as A
import Data.ByteString (ByteString)
-import qualified Data.ByteString.Char8 as Strict
+import qualified Data.ByteString.Char8 as BS
+import Data.CaseInsensitive (CI)
+import qualified Data.CaseInsensitive as CI
import Data.Char
import Data.Collections
import Data.Collections.BaseInstances ()
+import Data.Maybe
import Data.Monoid.Unicode
import Data.Ratio
+import Data.Text (Text)
+import qualified Data.Text as T
import Data.Time
import Data.Time.Clock.POSIX
import Network.URI
import System.Directory
import System.Time (ClockTime(..))
+-- |'Scheme' represents an URI scheme.
+type Scheme = CIAscii
+
+-- |'Host' represents an IP address or a host name in an URI
+-- authority.
+type Host = CI Text
+
+-- |'PathSegment' represents an URI path segment, split by slashes and
+-- percent-decoded.
+type PathSegment = ByteString
+
+-- |'PathSegments' is a list of URI path segments.
+type PathSegments = [PathSegment]
+
-- |>>> splitBy (== ':') "ab:c:def"
-- ["ab", "c", "def"]
splitBy ∷ (a → Bool) → [a] → [[a]]
go (A.toByteString str) (∅) ⊕
A.toAsciiBuilder "\""
where
- go ∷ Strict.ByteString → AsciiBuilder → AsciiBuilder
+ go ∷ ByteString → AsciiBuilder → AsciiBuilder
go bs ab
- = case Strict.break (≡ '"') bs of
+ = case BS.break (≡ '"') bs of
(x, y)
- | Strict.null y
+ | BS.null y
→ ab ⊕ b2ab x
| otherwise
- → go (Strict.tail y)
+ → go (BS.tail y)
(ab ⊕ b2ab x ⊕ A.toAsciiBuilder "\\\"")
- b2ab ∷ Strict.ByteString → AsciiBuilder
+ b2ab ∷ ByteString → AsciiBuilder
b2ab = A.toAsciiBuilder ∘ A.unsafeFromByteString
-- |>>> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
)
where
unescape ∷ String → ByteString
- unescape = Strict.pack ∘ unEscapeString ∘ map plusToSpace
+ unescape = BS.pack ∘ unEscapeString ∘ (plusToSpace <$>)
plusToSpace ∷ Char → Char
plusToSpace '+' = ' '
plusToSpace c = c
--- |>>> splitPathInfo "http://example.com/foo/bar"
+-- |>>> uriCIScheme "http://example.com/foo/bar"
+-- "http"
+uriCIScheme ∷ URI → Scheme
+{-# INLINE uriCIScheme #-}
+uriCIScheme = A.toCIAscii ∘ A.unsafeFromString ∘ uriScheme
+
+-- |>>> uriHost "http://example.com/foo/bar"
+-- "example.com"
+uriHost ∷ URI → Host
+{-# INLINE uriHost #-}
+uriHost = CI.mk ∘ T.pack ∘ uriRegName ∘ fromJust ∘ uriAuthority
+
+-- |>>> uriPathSegments "http://example.com/foo/bar"
-- ["foo", "bar"]
-splitPathInfo ∷ URI → [ByteString]
-splitPathInfo uri
+uriPathSegments ∷ URI → PathSegments
+uriPathSegments uri
= let reqPathStr = uriPath uri
- reqPath = [unEscapeString x | x ← splitBy (≡ '/') reqPathStr, (¬) (null x)]
+ reqPath = [ unEscapeString x
+ | x ← splitBy (≡ '/') reqPathStr, (¬) (null x) ]
in
- map Strict.pack reqPath
+ BS.pack <$> reqPath
-- |>>> trim " ab c d "
-- "ab c d"
where
clockTimeToUTC ∷ ClockTime → UTCTime
clockTimeToUTC (TOD sec picoSec)
- = posixSecondsToUTCTime
- $ fromRational
+ = posixSecondsToUTCTime ∘ fromRational
$ sec % 1 + picoSec % (1000 ⋅ 1000 ⋅ 1000 ⋅ 1000)