module Hack.Middleware.CleanPath (cleanPath, splitPath) where
import Hack
import qualified Data.ByteString.Lazy as BS
import Data.List
import Web.Encodings
import Data.List.Split
cleanPath :: Middleware
cleanPath app env =
case splitPath $ pathInfo env of
Left p -> do
let suffix =
case queryString env of
"" -> ""
q@('?':_) -> q
q -> '?' : q
return $! Response 303 [("Location", p ++ suffix)] BS.empty
Right _ -> app env
splitPath :: String -> Either String [String]
splitPath s =
let corrected = ats $ rds s
in if corrected == s
then Right $ map decodeUrl $ filter (\l -> length l /= 0)
$ splitOneOf "/" s
else Left corrected
rds :: String -> String
rds [] = []
rds [x] = [x]
rds (a:b:c)
| a == '/' && b == '/' = rds (b:c)
| otherwise = a : rds (b:c)
ats :: String -> String
ats [] = []
ats s =
if last s == '/' || dbs (reverse s)
then s
else s ++ "/"
dbs :: String -> Bool
dbs ('/':_) = False
dbs ('.':_) = True
dbs (_:x) = dbs x
dbs [] = False