X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FUtils.hs;h=7537eafcffacf7d8edf755e2bb8fea30cd636547;hb=c9a269666f2d60d9c5ba817e1c43b45f6d77de22;hp=d36c81b2853cb7e01adf861bed59e344b4181f7c;hpb=667baf9f664ccc093241287ad727b2839290f456;p=Lucu.git diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs index d36c81b..7537eaf 100644 --- a/Network/HTTP/Lucu/Utils.hs +++ b/Network/HTTP/Lucu/Utils.hs @@ -5,15 +5,13 @@ #-} -- |Utility functions used internally in this package. module Network.HTTP.Lucu.Utils - ( Scheme - , Host + ( Host , PathSegment - , PathSegments + , Path , splitBy , quoteStr , parseWWWFormURLEncoded - , uriCIScheme , uriHost , uriPathSegments , trim @@ -28,7 +26,7 @@ module Network.HTTP.Lucu.Utils where import Control.Applicative hiding (empty) import Control.Monad hiding (mapM) -import Data.Ascii (Ascii, AsciiBuilder, CIAscii) +import Data.Ascii (Ascii, AsciiBuilder) import qualified Data.Ascii as A import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS @@ -37,21 +35,18 @@ import qualified Data.CaseInsensitive as CI import Data.Char import Data.Collections import Data.Collections.BaseInstances () +import Data.Convertible.Base +import Data.Convertible.Instances.Ascii () +import Data.Convertible.Instances.Text () +import Data.Convertible.Instances.Time () 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 Prelude hiding (last, mapM, null, reverse) import Prelude.Unicode 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. @@ -61,8 +56,8 @@ type Host = CI Text -- percent-decoded. type PathSegment = ByteString --- |'PathSegments' is a list of URI path segments. -type PathSegments = [PathSegment] +-- |'Path' is a list of URI path segments. +type Path = [PathSegment] -- |>>> splitBy (== ':') "ab:c:def" -- ["ab", "c", "def"] @@ -79,9 +74,9 @@ splitBy isSep src -- >>> quoteStr "ab\"c" -- "\"ab\\\"c\"" quoteStr ∷ Ascii → AsciiBuilder -quoteStr str = A.toAsciiBuilder "\"" ⊕ - go (A.toByteString str) (∅) ⊕ - A.toAsciiBuilder "\"" +quoteStr str = cs ("\"" ∷ Ascii) ⊕ + go (cs str) (∅) ⊕ + cs ("\"" ∷ Ascii) where go ∷ ByteString → AsciiBuilder → AsciiBuilder go bs ab @@ -91,10 +86,10 @@ quoteStr str = A.toAsciiBuilder "\"" ⊕ → ab ⊕ b2ab x | otherwise → go (BS.tail y) - (ab ⊕ b2ab x ⊕ A.toAsciiBuilder "\\\"") + (ab ⊕ b2ab x ⊕ cs ("\\\"" ∷ Ascii)) b2ab ∷ ByteString → AsciiBuilder - b2ab = A.toAsciiBuilder ∘ A.unsafeFromByteString + b2ab = cs ∘ A.unsafeFromByteString -- |>>> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd" -- [("aaa", "bbb"), ("ccc", "ddd")] @@ -103,7 +98,7 @@ parseWWWFormURLEncoded src -- THINKME: We could gain some performance by using attoparsec -- here. | src ≡ "" = [] - | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') (A.toString src) + | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') (cs src) let (key, value) = break (≡ '=') pairStr return ( unescape key , unescape $ case value of @@ -118,21 +113,15 @@ parseWWWFormURLEncoded src plusToSpace '+' = ' ' plusToSpace c = c --- |>>> 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 +uriHost = CI.mk ∘ cs ∘ uriRegName ∘ fromJust ∘ uriAuthority -- |>>> uriPathSegments "http://example.com/foo/bar" -- ["foo", "bar"] -uriPathSegments ∷ URI → PathSegments +uriPathSegments ∷ URI → Path uriPathSegments uri = let reqPathStr = uriPath uri reqPath = [ unEscapeString x @@ -148,21 +137,21 @@ trim = reverse ∘ f ∘ reverse ∘ f f = dropWhile isSpace infixr 5 ⊲ --- | (B2;) = ('<|') +-- | (⊲) = ('<|') -- -- U+22B2, NORMAL SUBGROUP OF (⊲) ∷ Sequence α a ⇒ a → α → α (⊲) = (<|) infixl 5 ⊳ --- | (B3;) = ('|>') +-- | (⊳) = ('|>') -- -- U+22B3, CONTAINS AS NORMAL SUBGROUP (⊳) ∷ Sequence α a ⇒ α → a → α (⊳) = (|>) infixr 5 ⋈ --- | (C8;) = ('><') +-- | (⋈) = ('><') -- -- U+22C8, BOWTIE (⋈) ∷ Sequence α a ⇒ α → α → α @@ -177,9 +166,4 @@ mapM = flip foldrM empty ∘ (flip ((<$>) ∘ flip insert) ∘) -- |Get the modification time of a given file. getLastModified ∷ FilePath → IO UTCTime -getLastModified = (clockTimeToUTC <$>) ∘ getModificationTime - where - clockTimeToUTC ∷ ClockTime → UTCTime - clockTimeToUTC (TOD sec picoSec) - = posixSecondsToUTCTime ∘ fromRational - $ sec % 1 + picoSec % (1000 ⋅ 1000 ⋅ 1000 ⋅ 1000) +getLastModified = (cs <$>) ∘ getModificationTime