Resurrection from bitrot

[Rakka.git] / Rakka / Utils.hs

diff --git a/Rakka/Utils.hs b/Rakka/Utils.hs
index 0fddc6d64127baf25a1e5adbe19b58b5e758d039..3148c6bf108906112b39ebb81f63132ae8baa158 100644 (file)
--- a/Rakka/Utils.hs
+++ b/Rakka/Utils.hs
@@ -1,34 +1,49 @@
+{-# LANGUAGE
+    Arrows
+  , OverloadedStrings
+  , TypeOperators
+  , UnicodeSyntax
+  #-}

 module Rakka.Utils
     ( yesOrNo
 module Rakka.Utils
     ( yesOrNo

+    , trueOrFalse

     , parseYesOrNo
     , maybeA
     , deleteIfEmpty
     , chomp
     , guessMIMEType
     , parseYesOrNo
     , maybeA
     , deleteIfEmpty
     , chomp
     , guessMIMEType

+    , isSafeChar
+    , mkQueryString

     )
     where
     )
     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           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 Data.Monoid.Unicode
+import Data.String

 import           Magic
 import           Network.HTTP.Lucu
 import           Magic
 import           Network.HTTP.Lucu

+import           Network.URI
+import Prelude.Unicode

 import           System.IO.Unsafe
 
 import           System.IO.Unsafe
 

-
-yesOrNo :: Bool -> String
+yesOrNo ∷ Bool → String

 yesOrNo True  = "yes"
 yesOrNo False = "no"
 
 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
-                       "yes" -> returnA -< True
-                       "no"  -> returnA -< False
-                       _     -> returnA -< error ("Expected yes or no: " ++ str)
-
+parseYesOrNo ∷ (Eq s, Show s, IsString s, ArrowChoice (⇝)) ⇒ s ⇝ Bool
+parseYesOrNo
+    = proc str →
+      case str of
+        _ | str ≡ "yes" → returnA ⤙ True
+          | str ≡ "no"  → returnA ⤙ False
+          | otherwise   → returnA ⤙ error ("Expected yes or no: " ⊕ show str)

 
 maybeA :: (ArrowList a, ArrowChoice a) => a b c -> a b (Maybe c)
 maybeA a = listA a
 
 maybeA :: (ArrowList a, ArrowChoice a) => a b c -> a b (Maybe c)
 maybeA a = listA a


@@ -57,3 +72,23 @@ guessMIMEType = read . unsafePerformIO . magicString magic . L8.unpack
               $ do m <- magicOpen [MagicMime]
                    magicLoadDefault m
                    return m
               $ 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
+      encode :: String -> String
+      encode = escapeURIString isSafeChar . UTF8.encodeString
\ No newline at end of file