Network/HTTP/Lucu/Utils.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , UnicodeSyntax
   4   #-}
   5 -- |Utility functions used internally in the Lucu httpd. These
   6 -- functions may be useful too for something else.
   7 module Network.HTTP.Lucu.Utils
   8     ( splitBy
   9     , quoteStr
  10     , parseWWWFormURLEncoded
  11     , splitPathInfo
  12     , show3
  13     )
  14     where
  15 import Blaze.ByteString.Builder.ByteString as B
  16 import Blaze.Text.Int as BT
  17 import Control.Monad
  18 import Data.Ascii (Ascii, AsciiBuilder)
  19 import qualified Data.Ascii as A
  20 import Data.ByteString (ByteString)
  21 import qualified Data.ByteString.Char8 as BS
  22 import Data.List hiding (last)
  23 import Data.Monoid.Unicode
  24 import Network.URI
  25 import Prelude hiding (last)
  26 import Prelude.Unicode
  27
  28 -- |> splitBy (== ':') "ab:c:def"
  29 --  > ==> ["ab", "c", "def"]
  30 splitBy ∷ (a → Bool) → [a] → [[a]]
  31 {-# INLINEABLE splitBy #-}
  32 splitBy isSep src
  33     = case break isSep src of
  34         (last , []       ) → [last]
  35         (first, _sep:rest) → first : splitBy isSep rest
  36
  37 -- |> quoteStr "abc"
  38 --  > ==> "\"abc\""
  39 --
  40 --  > quoteStr "ab\"c"
  41 --  > ==> "\"ab\\\"c\""
  42 quoteStr ∷ Ascii → AsciiBuilder
  43 quoteStr str = A.toAsciiBuilder "\"" ⊕
  44                go (A.toByteString str) (∅) ⊕
  45                A.toAsciiBuilder "\""
  46     where
  47       go ∷ BS.ByteString → AsciiBuilder → AsciiBuilder
  48       go bs ab
  49           = case BS.break (≡ '"') bs of
  50               (x, y)
  51                   | BS.null y → ab ⊕ b2ab x
  52                   | otherwise → go (BS.tail y) (ab ⊕ b2ab x
  53                                                    ⊕ A.toAsciiBuilder "\\\"")
  54
  55       b2ab ∷ BS.ByteString → AsciiBuilder
  56       b2ab = A.toAsciiBuilder ∘ A.unsafeFromByteString
  57
  58 -- |> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
  59 --  > ==> [("aaa", "bbb"), ("ccc", "ddd")]
  60 parseWWWFormURLEncoded ∷ Ascii → [(ByteString, ByteString)]
  61 parseWWWFormURLEncoded src
  62     -- THINKME: We could gain some performance by using attoparsec
  63     -- here.
  64     | src ≡ ""  = []
  65     | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') (A.toString src)
  66                      let (key, value) = break (≡ '=') pairStr
  67                      return ( unescape key
  68                             , unescape $ case value of
  69                                            ('=':val) → val
  70                                            val       → val
  71                             )
  72     where
  73       unescape ∷ String → ByteString
  74       unescape = BS.pack ∘ unEscapeString ∘ map plusToSpace
  75
  76       plusToSpace ∷ Char → Char
  77       plusToSpace '+' = ' '
  78       plusToSpace c   = c
  79
  80 -- |> splitPathInfo "http://example.com/foo/bar"
  81 --  > ==> ["foo", "bar"]
  82 splitPathInfo ∷ URI → [ByteString]
  83 splitPathInfo uri
  84     = let reqPathStr = uriPath uri
  85           reqPath    = [unEscapeString x | x ← splitBy (≡ '/') reqPathStr, (¬) (null x)]
  86       in
  87         map BS.pack reqPath
  88
  89 -- |> show3 5
  90 --  > ==> "005"
  91 show3 ∷ Integral n ⇒ n → AsciiBuilder
  92 {-# INLINEABLE show3 #-}
  93 show3 = A.unsafeFromBuilder ∘ go
  94     where
  95       go i | i ≥ 0 ∧ i < 10   = B.fromByteString "00" ⊕ BT.digit    i
  96            | i ≥ 0 ∧ i < 100  = B.fromByteString "0"  ⊕ BT.integral i
  97            | i ≥ 0 ∧ i < 1000 =                         BT.integral i
  98            | otherwise        = error ("show3: the integer i must satisfy 0 <= i < 1000: " ⧺ show i)