X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHeaders.hs;h=e72022c72c0d5f11f253504fd5ed34c4288bd1d4;hb=6126eb9;hp=a5fdb022e7437e5add0071bcf723834b36f85c23;hpb=3fe5ca3bca04e0124a5f2440e893dc5375e0bb51;p=Lucu.git diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs index a5fdb02..e72022c 100644 --- a/Network/HTTP/Lucu/Headers.hs +++ b/Network/HTTP/Lucu/Headers.hs @@ -1,6 +1,5 @@ {-# LANGUAGE - BangPatterns - , GeneralizedNewtypeDeriving + GeneralizedNewtypeDeriving , OverloadedStrings , UnicodeSyntax #-} @@ -8,6 +7,8 @@ module Network.HTTP.Lucu.Headers ( Headers , HasHeaders(..) + , singleton + , toHeaders , fromHeaders @@ -37,21 +38,25 @@ class HasHeaders a where setHeaders ∷ a → Headers → a getHeader ∷ CIAscii → a → Maybe Ascii - {-# INLINE getHeader #-} - getHeader !key !a + getHeader key a = case getHeaders a of Headers m → M.lookup key m + getCIHeader ∷ CIAscii → a → Maybe CIAscii + {-# INLINE getCIHeader #-} + getCIHeader key a + = A.toCIAscii <$> getHeader key a + deleteHeader ∷ CIAscii → a → a {-# INLINE deleteHeader #-} - deleteHeader !key !a + deleteHeader key a = case getHeaders a of Headers m → setHeaders a $ Headers $ M.delete key m setHeader ∷ CIAscii → Ascii → a → a {-# INLINE setHeader #-} - setHeader !key !val !a + setHeader key val a = case getHeaders a of Headers m → setHeaders a $ Headers $ M.insert key val m @@ -60,6 +65,11 @@ instance HasHeaders Headers where getHeaders = id setHeaders _ = id +singleton ∷ CIAscii → Ascii → Headers +{-# INLINE singleton #-} +singleton key val + = Headers $ M.singleton key val + toHeaders ∷ [(CIAscii, Ascii)] → Headers {-# INLINE toHeaders #-} toHeaders = flip mkHeaders (∅) @@ -117,7 +127,7 @@ headersP = do xs ← P.many header {-# INLINE content #-} content = A.unsafeFromByteString <$> - takeWhile1 (\c → ((¬) (isSPHT c)) ∧ isText c) + takeWhile1 (\c → (¬) (isSPHT c) ∧ isText c) joinValues ∷ [Ascii] → Ascii {-# INLINE joinValues #-}