on warp-3.2.27-conn-closed-by-pear help sign in
45 lines 1.5 kB history raw
1{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
2module Util
3 ( relativeDirFromPieces
4 , defaultMkRedirect
5 , replace
6 , remove
7 , dropLastIfNull
8 ) where
10import WaiAppStatic.Types
11import qualified Data.Text as T
12import Data.ByteString (ByteString)
13import qualified Data.ByteString.Char8 as S8
14import qualified Data.Text.Encoding as TE
16-- alist helper functions
17replace :: Eq a => a -> b -> [(a, b)] -> [(a, b)]
18replace k v [] = [(k,v)]
19replace k v (x:xs) | fst x == k = (k,v):xs
20 | otherwise = x:replace k v xs
22remove :: Eq a => a -> [(a, b)] -> [(a, b)]
23remove _ [] = []
24remove k (x:xs) | fst x == k = xs
25 | otherwise = x:remove k xs
27-- | Turn a list of pieces into a relative path to the root folder.
28relativeDirFromPieces :: Pieces -> T.Text
29relativeDirFromPieces pieces = T.concat $ map (const "../") (drop 1 pieces) -- last piece is not a dir
31-- | Construct redirects with relative paths.
32defaultMkRedirect :: Pieces -> ByteString -> S8.ByteString
33defaultMkRedirect pieces newPath
34 | S8.null newPath || S8.null relDir ||
35 S8.last relDir /= '/' || S8.head newPath /= '/' =
36 relDir `S8.append` newPath
37 | otherwise = relDir `S8.append` S8.tail newPath
38 where
39 relDir = TE.encodeUtf8 (relativeDirFromPieces pieces)
41dropLastIfNull :: [Piece] -> [Piece]
42dropLastIfNull pieces = case pieces of
43 [fromPiece -> ""] -> []
44 (a : r) -> a : dropLastIfNull r
45 [] -> []