问将Yesod网络建立在具有非空路径的url上

EN

{-# LANGUAGE PackageImports #-}
import qualified Data.Text as Txt
import qualified "url" Network.URL as Url
import qualified Network.HTTP.Types as H
import qualified Data.Text.Encoding as TE
import qualified Data.List as L
import qualified "utf8-string" Data.ByteString.UTF8 as UTF8BS

-- instance Yesod App where

    -- cleanPath - A function used to clean up path segments. 
    -- It returns Right with a clean path or Left with a new set of pieces the user should be redirected to

    -- cleanPath :: Yesod a => a -> [Text] -> Either [Text] [Text]
    cleanPath master s =
        if corrected == s'
            then Right $ cutoffBasePrefix s'
            else Left $ cutoffBasePrefix corrected   -- to be redirected
      where
        -- avoid redirection on slash ended urls by junking the last piece if it's null

        s' = if not (L.null s) && Txt.null (last s) then init s else s

        corrected = filter (not . Txt.null) s'

        -- strToUtf8BS = TE.encodeUtf8 . Txt.pack  -- packs to UTF16 then encodes to UTF8
        strToUtf8BS = UTF8BS.fromString

        -- cut off "base prefix" or leave as it is

        cutoffBasePrefix segmts =
                case approot of
                     ApprootMaster f ->
                         case Url.importURL $ Txt.unpack $ f master of
                              Nothing -> segmts   -- not expected, incorrect url in settings.yml approot
                              Just url -> let basePrefixSegmts = H.decodePathSegments $ strToUtf8BS $ Url.url_path url in
                                          case basePrefixSegmts of
                                               [] -> segmts
                                               _ -> if basePrefixSegmts `L.isPrefixOf` segmts
                                                       then drop (length basePrefixSegmts) segmts
                                                       else segmts


                     _ -> segmts

, url                           >= 2.1.2
, network
, http-types
, utf8-string