X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FUtils.hs;h=15bc6f4043f5a87f149cd09a5147c4cb4cb5be7c;hb=9d86882fe1630c844e11cf2cf760110c04ea10d4;hp=92f3b1232f51eacb51cdddefeaa15c6db36258db;hpb=885faf1cabc3f79c90e1885268e2a9138b1ddefb;p=Rakka.git diff --git a/Rakka/Utils.hs b/Rakka/Utils.hs index 92f3b12..15bc6f4 100644 --- a/Rakka/Utils.hs +++ b/Rakka/Utils.hs @@ -1,17 +1,25 @@ module Rakka.Utils ( yesOrNo + , trueOrFalse , parseYesOrNo , maybeA - , defaultTo , deleteIfEmpty - , formatW3CDateTime + , chomp + , guessMIMEType + , isSafeChar + , mkQueryString ) where +import qualified Codec.Binary.UTF8.String as UTF8 import Control.Arrow import Control.Arrow.ArrowList -import System.Time -import Text.Printf +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 @@ -19,6 +27,11 @@ yesOrNo True = "yes" yesOrNo False = "no" +trueOrFalse :: Bool -> String +trueOrFalse True = "true" +trueOrFalse False = "false" + + parseYesOrNo :: ArrowChoice a => a String Bool parseYesOrNo = proc str -> do case str of @@ -35,13 +48,6 @@ maybeA a = listA a (x:_) -> returnA -< Just x -defaultTo :: ArrowChoice a => b -> a (Maybe b) b -defaultTo def - = proc m -> case m of - Nothing -> returnA -< def - Just x -> returnA -< x - - deleteIfEmpty :: (ArrowList a, ArrowChoice a) => a String String deleteIfEmpty = proc str -> do case str of @@ -49,34 +55,35 @@ deleteIfEmpty _ -> returnA -< str -formatW3CDateTime :: CalendarTime -> String -formatW3CDateTime time - = formatDateTime time ++ formatTimeZone time +chomp :: String -> String +chomp = reverse . snd . break (/= '\n') . reverse + + +guessMIMEType :: Lazy.ByteString -> MIMEType +guessMIMEType = read . unsafePerformIO . magicString magic . L8.unpack + where + magic :: Magic + magic = unsafePerformIO + $ do m <- magicOpen [MagicMime] + magicLoadDefault m + return m + + +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) where - formatDateTime :: CalendarTime -> String - formatDateTime time - = printf "%04d-%02d-%02dT%02d:%02d:%02d" - (ctYear time) - (fromEnum (ctMonth time) + 1) - (ctDay time) - (ctHour time) - (ctMin time) - (ctSec time) - - formatTimeZone :: CalendarTime -> String - formatTimeZone time - = case ctTZ time - of offset | offset < 0 -> '-':(showTZ $ negate offset) - | offset == 0 -> "Z" - | otherwise -> '+':(showTZ offset) - - showTZ :: Int -> String - showTZ offset - = let hour = offset `div` 3600 - min = (offset - hour * 3600) `div` 60 - in - show2 hour ++ ":" ++ show2 min - - show2 :: Int -> String - show2 n | n < 10 = '0':(show n) - | otherwise = show n \ No newline at end of file + encode :: String -> String + encode = escapeURIString isSafeChar . UTF8.encodeString \ No newline at end of file