module Network.Wai.Lens where
import Control.Lens
import Data.ByteString (ByteString)
import Data.Foldable
import Data.Monoid
import Data.Text (Text)
import Data.Tuple
import Data.Vault.Lazy (Vault)
import Network.Socket
import Network.HTTP.Types
import qualified Network.Wai as W
class HasMethod s a | s -> a where
method :: Lens' s a
instance HasMethod W.Request Method where
method = lens W.requestMethod $ \rq m -> rq { W.requestMethod = m }
class HasHttpVersion s a | s -> a where
httpVersion :: Lens' s a
instance HasHttpVersion W.Request HttpVersion where
httpVersion = lens W.httpVersion $ \rq v -> rq { W.httpVersion = v }
class HasRawPathInfo s a | s -> a where
rawPathInfo :: Lens' s a
instance HasRawPathInfo W.Request ByteString where
rawPathInfo = lens W.rawPathInfo $ \rq p -> rq { W.rawPathInfo = p }
class HasRawQueryString s a | s -> a where
rawQueryString :: Lens' s a
instance HasRawQueryString W.Request ByteString where
rawQueryString = lens W.rawQueryString $ \rq q -> rq { W.rawQueryString = q }
class HasHeaders s a | s -> a where
headers :: Lens' s a
instance HasHeaders W.Request RequestHeaders where
headers = lens W.requestHeaders $ \rq h -> rq { W.requestHeaders = h }
class HasRemoteHost s a | s -> a where
remoteHost :: Lens' s a
instance HasRemoteHost W.Request SockAddr where
remoteHost = lens W.remoteHost $ \rq h -> rq { W.remoteHost = h }
class HasPathInfo s a | s -> a where
pathInfo :: Lens' s a
instance HasPathInfo W.Request [Text] where
pathInfo = lens W.pathInfo $ \rq p -> rq { W.pathInfo = p }
class HasQueryString s a | s -> a where
queryString :: Lens' s a
instance HasQueryString W.Request Query where
queryString = lens W.queryString $ \rq q -> rq { W.queryString = q }
class HasRequestBody s a | s -> a where
requestBody :: Lens' s a
instance HasRequestBody W.Request (IO ByteString) where
requestBody = lens W.requestBody $ \rq b -> rq { W.requestBody = b }
class HasVault s a | s -> a where
vault :: Lens' s a
instance HasVault W.Request Vault where
vault = lens W.vault $ \rq v -> rq { W.vault = v }
class HasRequestBodyLength s a | s -> a where
requestBodyLength :: Lens' s a
instance HasRequestBodyLength W.Request W.RequestBodyLength where
requestBodyLength = lens W.requestBodyLength $ \rq l -> rq { W.requestBodyLength = l }
class HasStatus s a | s -> a where
status :: Lens' s a
value
:: (Eq a, Foldable f)
=> a
-> (b -> Const (First b) b)
-> f (a, b)
-> Const (First b) (f (a, b))
value n = folded . to swap . aside (only n) . _1