    {-# LANGUAGE CPP #-}
    module Network.Wai.Middleware.CleanPath
        ( cleanPath
        ) where

    import Network.Wai
    import qualified Data.ByteString.Char8 as B
    import qualified Data.ByteString.Lazy as L
    import Network.HTTP.Types (status301, hLocation)
    import Data.Text (Text)
    #if __GLASGOW_HASKELL__ < 710
    import Data.Monoid (mconcat)
    #endif

    cleanPath :: ([Text] -> Either B.ByteString [Text])
              -> B.ByteString
              -> ([Text] -> Application)
              -> Application
    cleanPath :: ([Text] -> Either ByteString [Text])
    -> ByteString -> ([Text] -> Application) -> Application
    cleanPath splitter :: [Text] -> Either ByteString [Text]
    splitter prefix :: ByteString
    prefix app :: [Text] -> Application
    app env :: Request
    env sendResponse :: Response -> IO ResponseReceived
    sendResponse =
        case [Text] -> Either ByteString [Text]
    splitter ([Text] -> Either ByteString [Text])
    -> [Text] -> Either ByteString [Text]
    forall a b. (a -> b) -> a -> b
    $ Request -> [Text]
    pathInfo Request
    env of
            Right pieces :: [Text]
    pieces -> [Text] -> Application
    app [Text]
    pieces Request
    env Response -> IO ResponseReceived
    sendResponse
            Left p :: ByteString
    p -> Response -> IO ResponseReceived
    sendResponse
                    (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> ByteString -> Response
    responseLBS Status
    status301
                      [(HeaderName
    hLocation, [ByteString] -> ByteString
    forall a. Monoid a => [a] -> a
    mconcat [ByteString
    prefix, ByteString
    p, ByteString
    suffix])]
                    (ByteString -> Response) -> ByteString -> Response
    forall a b. (a -> b) -> a -> b
    $ ByteString
    L.empty
        where
            -- include the query string if present
            suffix :: ByteString
    suffix =
                case ByteString -> Maybe (Char, ByteString)
    B.uncons (ByteString -> Maybe (Char, ByteString))
    -> ByteString -> Maybe (Char, ByteString)
    forall a b. (a -> b) -> a -> b
    $ Request -> ByteString
    rawQueryString Request
    env of
                    Nothing -> ByteString
    B.empty
                    Just ('?', _) -> Request -> ByteString
    rawQueryString Request
    env
                    _ -> Char -> ByteString -> ByteString
    B.cons '?' (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Request -> ByteString
    rawQueryString Request
    env