20 import Control.Arrow.ArrowList
21 import Data.ByteString (ByteString)
22 import qualified Data.ByteString as BS
23 import qualified Data.ByteString.Char8 as C8
24 import qualified Data.ByteString.Lazy as LS
25 import qualified Data.ByteString.Unsafe as BS
27 import Data.Monoid.Unicode
29 import Data.Text (Text)
30 import Data.Text.Encoding
32 import Network.HTTP.Lucu
35 import Prelude.Unicode
36 import System.IO.Unsafe
38 yesOrNo ∷ Bool → String
42 trueOrFalse ∷ Bool → String
43 trueOrFalse True = "true"
44 trueOrFalse False = "false"
46 parseYesOrNo ∷ (Eq s, Show s, IsString s, ArrowChoice (⇝)) ⇒ s ⇝ Bool
51 f str = error ("Expected yes or no: " ⊕ show str)
53 maybeA ∷ (ArrowList a, ArrowChoice a) ⇒ a b c → a b (Maybe c)
57 [] → returnA ⤙ Nothing
58 (x:_) → returnA ⤙ Just x
60 deleteIfEmpty ∷ (ArrowList a, ArrowChoice a) ⇒ a String String
62 = proc str → do case str of
66 chomp ∷ String → String
68 chomp = reverse . snd . break (≢ '\n') . reverse
70 guessMIMEType ∷ LS.ByteString → MIMEType
71 {-# INLINEABLE guessMIMEType #-}
74 ∘ flip BS.unsafeUseAsCStringLen (magicCString magic)
79 {-# NOINLINE magic #-}
80 magic = unsafePerformIO
81 $ do m ← magicOpen [MagicMime]
85 isSafeChar ∷ Char → Bool
86 {-# INLINEABLE isSafeChar #-}
89 | isReserved c = False
90 | c > ' ' ∧ c ≤ '~' = True
93 mkQueryString ∷ [(Text, Text)] → ByteString
94 {-# INLINEABLE mkQueryString #-}
95 mkQueryString = BS.intercalate (C8.singleton ';') ∘ map encodePair
97 encodePair ∷ (Text, Text) → ByteString
98 {-# INLINE encodePair #-}
100 = BS.intercalate (C8.singleton '=') [encodeText k, encodeText v]
102 encodeText ∷ Text → ByteString
103 {-# INLINE encodeText #-}
104 encodeText = toURLEncoded ∘ encodeUtf8
106 toURLEncoded ∷ ByteString → ByteString
107 {-# INLINEABLE toURLEncoded #-}
108 toURLEncoded = C8.concatMap go
110 go ∷ Char → ByteString
112 go c | c ≡ ' ' = C8.singleton '+'
113 | isReserved c = urlEncode c
114 | isUnreserved c = C8.singleton c
115 | otherwise = urlEncode c
117 urlEncode ∷ Char → ByteString
118 {-# INLINE urlEncode #-}
119 urlEncode c = C8.pack ('%':toHex (ord c))
124 = case showIntAtBase 16 toChrHex n "" of
129 toChrHex ∷ Int → Char
130 {-# INLINE toChrHex #-}
132 | d < 10 = chr (ord '0' + fromIntegral d )
133 | otherwise = chr (ord 'A' + fromIntegral (d-10))