X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FUtils.hs;h=9cc06984440e09a9d7afe2ec12411f550d1a1f56;hp=15bc6f4043f5a87f149cd09a5147c4cb4cb5be7c;hb=88747f2;hpb=fdf3b6945a61a285c584a855a7c290281a6fb4ea diff --git a/Rakka/Utils.hs b/Rakka/Utils.hs index 15bc6f4..9cc0698 100644 --- a/Rakka/Utils.hs +++ b/Rakka/Utils.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + Arrows + , UnicodeSyntax + #-} module Rakka.Utils ( yesOrNo , trueOrFalse @@ -10,80 +14,85 @@ module Rakka.Utils , mkQueryString ) where - -import qualified Codec.Binary.UTF8.String as UTF8 -import Control.Arrow -import Control.Arrow.ArrowList -import qualified Data.ByteString.Lazy as Lazy (ByteString) -import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString) -import Magic -import Network.HTTP.Lucu -import Network.URI -import System.IO.Unsafe - - -yesOrNo :: Bool -> String +import qualified Codec.Binary.Url as Url +import Control.Arrow +import Control.Arrow.ArrowList +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LS +import qualified Data.ByteString.Lazy.Char8 as L8 +import Data.List +import qualified Data.Text as T +import Data.Text.Encoding +import Network.HTTP.Lucu +import Network.URI +import Prelude.Unicode +import System.IO.Unsafe + + +yesOrNo ∷ Bool → String yesOrNo True = "yes" yesOrNo False = "no" -trueOrFalse :: Bool -> String +trueOrFalse ∷ Bool → String trueOrFalse True = "true" trueOrFalse False = "false" -parseYesOrNo :: ArrowChoice a => a String Bool +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) + = proc str → do case str of + "yes" → returnA -< True + "no" → returnA -< False + _ → returnA -< error ("Expected yes or no: " ⧺ str) -maybeA :: (ArrowList a, ArrowChoice a) => a b c -> a b (Maybe c) +maybeA ∷ (ArrowList a, ArrowChoice a) => a b c → a b (Maybe c) maybeA a = listA a >>> - proc xs -> case xs of - [] -> returnA -< Nothing - (x:_) -> returnA -< Just x + proc xs → case xs of + [] → returnA -< Nothing + (x:_) → returnA -< Just x -deleteIfEmpty :: (ArrowList a, ArrowChoice a) => a String String +deleteIfEmpty ∷ (ArrowList a, ArrowChoice a) => a String String deleteIfEmpty - = proc str -> do case str of - "" -> none -< () - _ -> returnA -< str + = proc str → do case str of + "" → none -< () + _ → returnA -< str -chomp :: String -> String +chomp ∷ String → String chomp = reverse . snd . break (/= '\n') . reverse -guessMIMEType :: Lazy.ByteString -> MIMEType +guessMIMEType ∷ LS.ByteString → MIMEType guessMIMEType = read . unsafePerformIO . magicString magic . L8.unpack where - magic :: Magic + magic ∷ Magic magic = unsafePerformIO $ do m <- magicOpen [MagicMime] magicLoadDefault m return m -isSafeChar :: Char -> Bool +isSafeChar ∷ Char → Bool isSafeChar c - | c == '/' = True - | isReserved c = False - | c > ' ' && c <= '~' = True - | otherwise = False - - -mkQueryString :: [(String, String)] -> String -mkQueryString [] = "" -mkQueryString ((k, v) : xs) = encode k ++ "=" ++ encode v ++ - if xs == [] then - "" - else - ';' : mkQueryString(xs) + | c ≡ '/' = True + | isReserved c = False + | isUnreserved c = True + | otherwise = False + + +mkQueryString ∷ [(T.Text, T.Text)] → String +{-# INLINEABLE mkQueryString #-} +mkQueryString = intercalate ";" ∘ map pairToStr where - encode :: String -> String - encode = escapeURIString isSafeChar . UTF8.encodeString \ No newline at end of file + pairToStr ∷ (T.Text, T.Text) → String + {-# INLINE pairToStr #-} + pairToStr (k, v) + = encode k ⧺ ('=':encode v) + + encode ∷ T.Text → String + {-# INLINE encode #-} + encode = Url.encode ∘ BS.unpack ∘ encodeUtf8