X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FUtils.hs;h=717a6068bddfa332b8dddb1edbcd94dc8ed39891;hp=e89fee08c381e21c66bdd498556442915a64e047;hb=45bce2c29948649f74ada71f2fa851bdb812e96c;hpb=9932fbe6504e8b812703291e2497a5f010880d3b diff --git a/Rakka/Utils.hs b/Rakka/Utils.hs index e89fee0..717a606 100644 --- a/Rakka/Utils.hs +++ b/Rakka/Utils.hs @@ -1,5 +1,7 @@ {-# LANGUAGE Arrows + , OverloadedStrings + , TypeOperators , UnicodeSyntax #-} module Rakka.Utils @@ -10,19 +12,21 @@ module Rakka.Utils , deleteIfEmpty , chomp , guessMIMEType + , isSafeChar , mkQueryString ) where import Control.Arrow import Control.Arrow.ArrowList -import Data.Ascii (Ascii) -import qualified Data.Ascii as A +import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C8 -import qualified Data.ByteString.Unsafe as BS import qualified Data.ByteString.Lazy as LS +import qualified Data.ByteString.Unsafe as BS import Data.Char -import qualified Data.Text as T +import Data.Monoid.Unicode +import Data.String +import Data.Text (Text) import Data.Text.Encoding import Magic import Network.HTTP.Lucu @@ -39,12 +43,12 @@ trueOrFalse ∷ Bool → String trueOrFalse True = "true" trueOrFalse False = "false" -parseYesOrNo ∷ ArrowChoice a ⇒ a String Bool -parseYesOrNo - = proc str → do case str of - "yes" → returnA ⤙ True - "no" → returnA ⤙ False - _ → returnA ⤙ error ("Expected yes or no: " ⧺ str) +parseYesOrNo ∷ (Eq s, Show s, IsString s, ArrowChoice (⇝)) ⇒ s ⇝ Bool +parseYesOrNo = arr f + where + f "yes" = True + f "no" = False + f str = error ("Expected yes or no: " ⊕ show str) maybeA ∷ (ArrowList a, ArrowChoice a) ⇒ a b c → a b (Maybe c) maybeA a = listA a @@ -78,7 +82,6 @@ guessMIMEType = read magicLoadDefault m return m -{- isSafeChar ∷ Char → Bool {-# INLINEABLE isSafeChar #-} isSafeChar c @@ -86,35 +89,32 @@ isSafeChar c | isReserved c = False | c > ' ' ∧ c ≤ '~' = True | otherwise = False --} -mkQueryString ∷ [(T.Text, T.Text)] → Ascii +mkQueryString ∷ [(Text, Text)] → ByteString {-# INLINEABLE mkQueryString #-} -mkQueryString = A.unsafeFromByteString - ∘ BS.intercalate (C8.singleton ';') - ∘ map encodePair +mkQueryString = BS.intercalate (C8.singleton ';') ∘ map encodePair where - encodePair ∷ (T.Text, T.Text) → BS.ByteString + encodePair ∷ (Text, Text) → ByteString {-# INLINE encodePair #-} encodePair (k, v) = BS.intercalate (C8.singleton '=') [encodeText k, encodeText v] - encodeText ∷ T.Text → BS.ByteString + encodeText ∷ Text → ByteString {-# INLINE encodeText #-} encodeText = toURLEncoded ∘ encodeUtf8 -toURLEncoded ∷ BS.ByteString → BS.ByteString +toURLEncoded ∷ ByteString → ByteString {-# INLINEABLE toURLEncoded #-} toURLEncoded = C8.concatMap go where - go ∷ Char → BS.ByteString + go ∷ Char → ByteString {-# INLINE go #-} go c | c ≡ ' ' = C8.singleton '+' | isReserved c = urlEncode c | isUnreserved c = C8.singleton c | otherwise = urlEncode c - urlEncode ∷ Char → BS.ByteString + urlEncode ∷ Char → ByteString {-# INLINE urlEncode #-} urlEncode c = C8.pack ('%':toHex (ord c))