X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FUtils.hs;h=693fdf2ebae8b695e7b1c30596c2e81d5bd09c40;hb=522dde5470584bb3f82cb0b4179233724d2408d0;hp=9f2873c9ae328d626d9679b2ac0c777750c1e50e;hpb=3c5211253dc61c31196a47486c538b64c32d8c5e;p=Rakka.git diff --git a/Rakka/Utils.hs b/Rakka/Utils.hs index 9f2873c..693fdf2 100644 --- a/Rakka/Utils.hs +++ b/Rakka/Utils.hs @@ -1,17 +1,21 @@ module Rakka.Utils ( yesOrNo + , trueOrFalse , parseYesOrNo , maybeA , deleteIfEmpty - , formatW3CDateTime , chomp + , guessMIMEType ) where 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 System.IO.Unsafe yesOrNo :: Bool -> String @@ -19,6 +23,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 @@ -42,38 +51,15 @@ deleteIfEmpty _ -> returnA -< str -formatW3CDateTime :: CalendarTime -> String -formatW3CDateTime time - = formatDateTime time ++ formatTimeZone time - 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 - - 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