-- | {-# LANGUAGE FlexibleContexts #-} module Network.HTTP.Pony.Transformer.StartLine where import Control.Lens (over, ASetter, _1, _2, view , Field1, Field2, set, Getting) import Data.Attoparsec.ByteString (parse, eitherResult) import Data.ByteString (ByteString) import qualified Network.HTTP.Types as HTTP import qualified Network.HTTP.Pony.Transformer.StartLine.Builder as Builder import qualified Network.HTTP.Pony.Transformer.StartLine.Parser as Parser import Network.HTTP.Pony.Transformer.StartLine.Type (RequestURI, RequestLine, ResponseLine) -- Here f and f' should really be the same Lens from the Request into the StartLine startLineWith :: (Monoid a, Monad f) => Getting ByteString s ByteString -> ASetter s t a1 RequestLine -> ASetter s1 a ResponseLine ByteString -> (t -> f s1) -> s -> f a startLineWith f f' g app request = do let requestLine = view f request case eitherResult (parse Parser.requestLineTokens requestLine) of Left _ -> pure mempty Right r -> do response <- app (set f' r request) pure (over g Builder.response response) startLine :: ( Field1 s3 b2 ByteString ByteString , Field1 s3 b ByteString (HTTP.Method, RequestURI, HTTP.HttpVersion) , Field1 s2 b1 ResponseLine ByteString , Field1 s1 a s2 b1 , Field1 s s s3 b2 , Field1 s t s3 b , Monoid a , Monad f) => (t -> f s1) -> s -> f a startLine = startLineWith (_1 . _1) (_1 . _1) (_1 . _1)