dea10f7 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

FilePath datatype

dea10f7Michael Snoyman15 years ago

Network/Wai/Application/Static.hs+90−94

compare with master

unifiedsplit

@@ -26,12 +26,8 @@ module Network.Wai.Application.Static

26 , mimeTypeByExt

27 , defaultMimeTypeByExt

28 -- ** Finding files

29− , Piece (..)

30 , Pieces

29 , Pieces

31 , pathFromPieces

30 , pathFromPieces

32− , fixPathName

33− , unfixPathName

34− , toPiece

35 -- ** Directory listings

31 -- ** Directory listings

36 , Listing

32 , Listing

37 , defaultListing

33 , defaultListing

@@ -46,9 +42,14 @@ module Network.Wai.Application.Static

46 , defaultMkRedirect

42 , defaultMkRedirect

47 -- * Other data types

43 -- * Other data types

48 , File (..)

44 , File (..)

45+ , FilePath (..)

46+ , toFilePath

47+ , fromFilePath

49 , MaxAge (..)

48 , MaxAge (..)

50 ) where

49 ) where

51+import Prelude hiding (FilePath)

52+import qualified Prelude

52import qualified Network.Wai as W

53import qualified Network.Wai as W

53import qualified Network.HTTP.Types as H

54import qualified Network.HTTP.Types as H

54import Data.Map (Map)

55import Data.Map (Map)

@@ -77,34 +78,38 @@ import System.Locale (defaultTimeLocale)

78import Data.FileEmbed (embedFile)

79import Data.FileEmbed (embedFile)

81+import Data.Text (Text)

80import qualified Data.Text as T

82import qualified Data.Text as T

81import qualified Data.Text.Encoding as TE

83import qualified Data.Text.Encoding as TE

82import qualified Data.Text.Encoding.Error as TEE

84import qualified Data.Text.Encoding.Error as TEE

84import Control.Arrow ((&&&), second)

86import Control.Arrow ((&&&), second)

85−import Data.List (groupBy, sortBy, find)

87+import Data.List (groupBy, sortBy, find, foldl')

86import Data.Function (on)

88import Data.Function (on)

87import Data.Ord (comparing)

89import Data.Ord (comparing)

88import qualified Data.ByteString.Base64 as B64

90import qualified Data.ByteString.Base64 as B64

89import Data.Either (rights)

91import Data.Either (rights)

90import Data.Maybe (isJust, fromJust)

92import Data.Maybe (isJust, fromJust)

91import Network.HTTP.Date (parseHTTPDate, epochTimeToHTTPDate, formatHTTPDate)

93import Network.HTTP.Date (parseHTTPDate, epochTimeToHTTPDate, formatHTTPDate)

94+import Data.String (IsString (..))

93−import Debug.Trace

96+newtype FilePath = FilePath { unFilePath :: Text }

94−debug :: (Show a) => a -> a

97+ deriving (Ord, Eq, Show)

95−debug a = trace ("DEBUG: " ++ show a) a

98+instance IsString FilePath where

96−{-

99+ fromString = toFilePath

97−-}

100+

101+(</>) :: FilePath -> FilePath -> FilePath

102+(FilePath a) </> (FilePath b) = FilePath $ T.concat [a, "/", b]

103

99-- | A list of all possible extensions, starting from the largest.

104-- | A list of all possible extensions, starting from the largest.

100−takeExtensions :: FilePath -> [String]

105+takeExtensions :: FilePath -> [FilePath]

101−takeExtensions s =

106+takeExtensions (FilePath s) =

102− case break (== '.') s of

107+ case T.break (== '.') s of

108+ (_, "") -> []

103− (_, '.':x) -> x : takeExtensions x

109+ (_, x) -> FilePath (T.drop 1 x) : takeExtensions (FilePath $ T.drop 1 x)

104− (_, _) -> []

105

110

106type MimeType = ByteString

111type MimeType = ByteString

107−type Extension = String

112+type Extension = FilePath

108type MimeMap = Map Extension MimeType

113type MimeMap = Map Extension MimeType

109

114

110defaultMimeType :: MimeType

115defaultMimeType :: MimeType

@@ -214,54 +219,52 @@ filterButLast f (x:xs)

214 | otherwise = filterButLast f xs

219 | otherwise = filterButLast f xs

215

220

216

221

217−unsafe :: T.Text -> Bool

222+unsafe :: FilePath -> Bool

223+unsafe (FilePath s)

218−unsafe s | T.null s = False

224+ | T.null s = False

219− | T.head s == '.' = True

225+ | T.head s == '.' = True

220− | otherwise = T.any (== '/') s

226+ | otherwise = T.any (== '/') s

227+

228+nullFilePath :: FilePath -> Bool

229+nullFilePath = T.null . unFilePath

221

230

222stripTrailingSlash :: FilePath -> FilePath

231stripTrailingSlash :: FilePath -> FilePath

223−stripTrailingSlash "/" = ""

232+stripTrailingSlash fp@(FilePath t)

224−stripTrailingSlash "" = ""

233+ | T.null t || T.last t /= '/' = fp

225−stripTrailingSlash (x:xs) = x : stripTrailingSlash xs

234+ | otherwise = FilePath $ T.init t

226

235

227−data Piece = Piece

228− { pieceRaw :: FilePath

229− , piecePretty :: T.Text

230− }

231− deriving (Eq, Ord, Show)

232−type Pieces = [Piece]

236+type Pieces = [FilePath]

233

237

234relativeDirFromPieces :: Pieces -> T.Text

238relativeDirFromPieces :: Pieces -> T.Text

235relativeDirFromPieces pieces = T.concat $ map (const "../") (drop 1 pieces) -- last piece is not a dir

239relativeDirFromPieces pieces = T.concat $ map (const "../") (drop 1 pieces) -- last piece is not a dir

236

240

237pathFromPieces :: FilePath -> Pieces -> FilePath

241pathFromPieces :: FilePath -> Pieces -> FilePath

238−pathFromPieces prefix pieces =

242+pathFromPieces = foldl' (</>)

239− concat $ prefix : map ((:) '/') (map pieceRaw pieces)

240

243

241checkSpecialDirListing :: Pieces -> Maybe CheckPieces

244checkSpecialDirListing :: Pieces -> Maybe CheckPieces

242−checkSpecialDirListing [Piece _ ".hidden", Piece _ "folder.png"] =

245+checkSpecialDirListing [".hidden", "folder.png"] =

243 Just $ SendContent "image/png" $ L.fromChunks [$(embedFile "folder.png")]

246 Just $ SendContent "image/png" $ L.fromChunks [$(embedFile "folder.png")]

244−checkSpecialDirListing [Piece _ ".hidden", Piece _ "haskell.png"] =

247+checkSpecialDirListing [".hidden", "haskell.png"] =

245 Just $ SendContent "image/png" $ L.fromChunks [$(embedFile "haskell.png")]

248 Just $ SendContent "image/png" $ L.fromChunks [$(embedFile "haskell.png")]

246checkSpecialDirListing _ = Nothing

249checkSpecialDirListing _ = Nothing

247

250

248checkPieces :: (Pieces -> IO FileLookup) -- ^ file lookup function

251checkPieces :: (Pieces -> IO FileLookup) -- ^ file lookup function

249− -> [T.Text] -- ^ List of default index files. Cannot contain slashes.

252+ -> [FilePath] -- ^ List of default index files. Cannot contain slashes.

250 -> Pieces -- ^ parsed request

253 -> Pieces -- ^ parsed request

251 -> W.Request

254 -> W.Request

252 -> MaxAge

255 -> MaxAge

253 -> Bool

256 -> Bool

254 -> IO CheckPieces

257 -> IO CheckPieces

255checkPieces fileLookup indices pieces req maxAge useHash

258checkPieces fileLookup indices pieces req maxAge useHash

256− | any (unsafe . piecePretty) pieces = return Forbidden

259+ | any unsafe pieces = return Forbidden

257− | any (T.null . piecePretty) $ safeInit pieces =

260+ | any nullFilePath $ safeInit pieces =

258− return $ Redirect (filterButLast (not . T.null . piecePretty) pieces) Nothing

261+ return $ Redirect (filterButLast (not . nullFilePath) pieces) Nothing

259 | otherwise = do

262 | otherwise = do

260 let (isFile, isFolder) =

263 let (isFile, isFolder) =

261 case () of

264 case () of

262 ()

265 ()

263 | null pieces -> (True, True)

266 | null pieces -> (True, True)

264− | T.null $ piecePretty (last pieces) -> (False, True)

267+ | nullFilePath (last pieces) -> (False, True)

265 | otherwise -> (True, False)

268 | otherwise -> (True, False)

266

269

267 fl <- fileLookup pieces

270 fl <- fileLookup pieces

@@ -271,11 +274,11 @@ checkPieces fileLookup indices pieces req maxAge useHash

271 (Just Right{}, False) -> return $ Redirect (init pieces) Nothing

274 (Just Right{}, False) -> return $ Redirect (init pieces) Nothing

272 (Just (Left folder@(Folder _ contents)), _) -> do

275 (Just (Left folder@(Folder _ contents)), _) -> do

273 case checkIndices $ map fileName $ rights contents of

276 case checkIndices $ map fileName $ rights contents of

274− Just index -> return $ Redirect (setLast pieces $ Piece (T.unpack index) index) Nothing

277+ Just index -> return $ Redirect (setLast pieces index) Nothing

275 Nothing ->

278 Nothing ->

276 if isFolder

279 if isFolder

277 then return $ DirectoryResponse folder

280 then return $ DirectoryResponse folder

278− else return $ Redirect (pieces ++ [Piece "" ""]) Nothing

281+ else return $ Redirect (pieces ++ [""]) Nothing

279 where

282 where

280 headers = W.requestHeaders req

283 headers = W.requestHeaders req

281 queryString = W.queryString req

284 queryString = W.queryString req

@@ -337,12 +340,12 @@ checkPieces fileLookup indices pieces req maxAge useHash

337 Nothing -> return $ FileResponse file $ [("last-modified", formatHTTPDate mdate)]

340 Nothing -> return $ FileResponse file $ [("last-modified", formatHTTPDate mdate)]

338 _ -> return $ FileResponse file []

341 _ -> return $ FileResponse file []

339

342

340− setLast :: Pieces -> Piece -> Pieces

343+ setLast :: Pieces -> FilePath -> Pieces

341 setLast [] x = [x]

344 setLast [] x = [x]

342− setLast [Piece "" ""] x = [x]

345+ setLast [""] x = [x]

343 setLast (a:b) x = a : setLast b x

346 setLast (a:b) x = a : setLast b x

344

347

345− checkIndices :: [T.Text] -> Maybe T.Text

348+ checkIndices :: [FilePath] -> Maybe FilePath

346 checkIndices contents = find (flip elem indices) contents

349 checkIndices contents = find (flip elem indices) contents

347

350

348 cacheControl = case ccInt of

351 cacheControl = case ccInt of

@@ -363,14 +366,14 @@ type Listing = (Pieces -> Folder -> IO L.ByteString)

363type FileLookup = Maybe (Either Folder File)

366type FileLookup = Maybe (Either Folder File)

364

367

365data Folder = Folder

368data Folder = Folder

366− { folderName :: T.Text

369+ { folderName :: FilePath

367 , folderContents :: [Either Folder File]

370 , folderContents :: [Either Folder File]

368 }

371 }

369

372

370data File = File

373data File = File

371 { fileGetSize :: Int

374 { fileGetSize :: Int

372 , fileToResponse :: H.Status -> H.ResponseHeaders -> W.Response

375 , fileToResponse :: H.Status -> H.ResponseHeaders -> W.Response

373− , fileName :: T.Text

376+ , fileName :: FilePath

374 , fileGetHash :: Maybe (IO ByteString)

377 , fileGetHash :: Maybe (IO ByteString)

375 , fileGetModified :: Maybe EpochTime

378 , fileGetModified :: Maybe EpochTime

376 }

379 }

@@ -400,7 +403,7 @@ defaultWebAppSettings :: StaticSettings

400defaultWebAppSettings = StaticSettings

403defaultWebAppSettings = StaticSettings

401 { ssFolder = fileSystemLookup "static"

404 { ssFolder = fileSystemLookup "static"

402 , ssMkRedirect = defaultMkRedirect

405 , ssMkRedirect = defaultMkRedirect

403− , ssGetMimeType = return . defaultMimeTypeByExt . T.unpack . fileName

406+ , ssGetMimeType = return . defaultMimeTypeByExt . fileName

404 , ssMaxAge = MaxAgeForever

407 , ssMaxAge = MaxAgeForever

405 , ssListing = Nothing

408 , ssListing = Nothing

406 , ssIndices = []

409 , ssIndices = []

@@ -411,24 +414,24 @@ defaultFileServerSettings :: StaticSettings

411defaultFileServerSettings = StaticSettings

414defaultFileServerSettings = StaticSettings

412 { ssFolder = fileSystemLookup "static"

415 { ssFolder = fileSystemLookup "static"

413 , ssMkRedirect = defaultMkRedirect

416 , ssMkRedirect = defaultMkRedirect

414− , ssGetMimeType = return . defaultMimeTypeByExt . T.unpack . fileName

417+ , ssGetMimeType = return . defaultMimeTypeByExt . fileName

415 , ssMaxAge = MaxAgeSeconds $ 60 * 60

418 , ssMaxAge = MaxAgeSeconds $ 60 * 60

416 , ssListing = Just defaultListing

419 , ssListing = Just defaultListing

417 , ssIndices = ["index.html", "index.htm"]

420 , ssIndices = ["index.html", "index.htm"]

418 , ssUseHash = False

421 , ssUseHash = False

419 }

422 }

420

423

421−fileHelper :: FilePath -> T.Text -> IO File

424+fileHelper :: FilePath -> FilePath -> IO File

422fileHelper fp name = do

425fileHelper fp name = do

423− fs <- getFileStatus fp

426+ fs <- getFileStatus $ fromFilePath fp

424 return File

427 return File

425 { fileGetSize = fromIntegral $ fileSize fs

428 { fileGetSize = fromIntegral $ fileSize fs

426− , fileToResponse = \s h -> W.ResponseFile s h fp Nothing

429+ , fileToResponse = \s h -> W.ResponseFile s h (fromFilePath fp) Nothing

427 , fileName = name

430 , fileName = name

428 , fileGetHash = Just $ do

431 , fileGetHash = Just $ do

429 -- FIXME replace lazy IO with enumerators

432 -- FIXME replace lazy IO with enumerators

430 -- FIXME let's use a dictionary to cache these values?

433 -- FIXME let's use a dictionary to cache these values?

431− l <- L.readFile fp

434+ l <- L.readFile $ fromFilePath fp

432 return $ runHashL l

435 return $ runHashL l

433 , fileGetModified = Just $ modificationTime fs

436 , fileGetModified = Just $ modificationTime fs

434 }

437 }

@@ -436,35 +439,35 @@ fileHelper fp name = do

436fileSystemLookup :: FilePath -> Pieces -> IO FileLookup

439fileSystemLookup :: FilePath -> Pieces -> IO FileLookup

437fileSystemLookup prefix pieces = do

440fileSystemLookup prefix pieces = do

438 let fp = pathFromPieces prefix pieces

441 let fp = pathFromPieces prefix pieces

439− fe <- doesFileExist fp

442+ fe <- doesFileExist $ fromFilePath fp

440 if fe

443 if fe

441− then fmap (Just . Right) $ fileHelper fp (piecePretty $ last pieces)

444+ then fmap (Just . Right) $ fileHelper fp $ last pieces

442 else do

445 else do

443− de <- doesDirectoryExist fp

446+ de <- doesDirectoryExist $ fromFilePath fp

444 if de

447 if de

445 then do

448 then do

446 let isVisible ('.':_) = return False

449 let isVisible ('.':_) = return False

447 isVisible "" = return False

450 isVisible "" = return False

448 isVisible _ = return True

451 isVisible _ = return True

449− entries <- getDirectoryContents fp >>= filterM isVisible >>= (mapM $ \name -> do

452+ entries <- getDirectoryContents (fromFilePath fp) >>= filterM isVisible >>= mapM (\nameRaw -> do

450− let name' = T.pack $ fixPathName name

453+ let name = toFilePath nameRaw

451− let fp' = fp ++ '/' : name

454+ let fp' = fp </> name

452− fe' <- doesFileExist fp'

455+ fe' <- doesFileExist $ fromFilePath fp'

453 if fe'

456 if fe'

454− then fmap Right $ fileHelper fp' name'

457+ then fmap Right $ fileHelper fp' name

455− else return $ Left $ Folder name' [])

458+ else return $ Left $ Folder name [])

456 return $ Just $ Left $ Folder (error "413") entries

459 return $ Just $ Left $ Folder (error "413") entries

457 else return Nothing

460 else return Nothing

458

461

459−type Embedded = Map.Map T.Text EmbeddedEntry

462+type Embedded = Map.Map FilePath EmbeddedEntry

460

463

461data EmbeddedEntry = EEFile S8.ByteString | EEFolder Embedded

464data EmbeddedEntry = EEFile S8.ByteString | EEFolder Embedded

462

465

463embeddedLookup :: Embedded -> Pieces -> IO FileLookup

466embeddedLookup :: Embedded -> Pieces -> IO FileLookup

464embeddedLookup root pieces =

467embeddedLookup root pieces =

465− return $ elookup "<root>" (map piecePretty pieces) root

468+ return $ elookup "<root>" pieces root

466 where

469 where

467− elookup :: T.Text -> [T.Text] -> Embedded -> FileLookup

470+ elookup :: FilePath -> [FilePath] -> Embedded -> FileLookup

468 elookup p [] x = Just $ Left $ Folder p $ map toEntry $ Map.toList x

471 elookup p [] x = Just $ Left $ Folder p $ map toEntry $ Map.toList x

469 elookup p [""] x = elookup p [] x

472 elookup p [""] x = elookup p [] x

470 elookup _ (p:ps) x =

473 elookup _ (p:ps) x =

@@ -476,7 +479,7 @@ embeddedLookup root pieces =

476 _ -> Nothing

479 _ -> Nothing

477 Just (EEFolder y) -> elookup p ps y

480 Just (EEFolder y) -> elookup p ps y

478

481

479−toEntry :: (T.Text, EmbeddedEntry) -> Either Folder File

482+toEntry :: (FilePath, EmbeddedEntry) -> Either Folder File

480toEntry (name, EEFolder{}) = Left $ Folder name []

483toEntry (name, EEFolder{}) = Left $ Folder name []

481toEntry (name, EEFile bs) = Right $ File

484toEntry (name, EEFile bs) = Right $ File

482 { fileGetSize = S8.length bs

485 { fileGetSize = S8.length bs

@@ -486,30 +489,29 @@ toEntry (name, EEFile bs) = Right $ File

486 , fileGetModified = Nothing

489 , fileGetModified = Nothing

487 }

490 }

488

491

489−toEmbedded :: [(FilePath, S8.ByteString)] -> Embedded

492+toEmbedded :: [(Prelude.FilePath, S8.ByteString)] -> Embedded

490toEmbedded fps =

493toEmbedded fps =

491 go texts

494 go texts

492 where

495 where

493− texts = map (\(x, y) -> (filter (not . T.null) $ toPieces x, y)) fps

496+ texts = map (\(x, y) -> (filter (not . T.null . unFilePath) $ toPieces x, y)) fps

494− toPiece' fp = T.pack $ fixPathName fp

495 toPieces "" = []

497 toPieces "" = []

496 toPieces x =

498 toPieces x =

497 let (y, z) = break (== '/') x

499 let (y, z) = break (== '/') x

498− in toPiece' y : toPieces (drop 1 z)

500+ in toFilePath y : toPieces (drop 1 z)

499− go :: [([T.Text], S8.ByteString)] -> Embedded

501+ go :: [([FilePath], S8.ByteString)] -> Embedded

500 go orig =

502 go orig =

501 Map.fromList $ map (second go') hoisted

503 Map.fromList $ map (second go') hoisted

502 where

504 where

503 next = map (\(x, y) -> (head x, (tail x, y))) orig

505 next = map (\(x, y) -> (head x, (tail x, y))) orig

504− grouped :: [[(T.Text, ([T.Text], S8.ByteString))]]

506+ grouped :: [[(FilePath, ([FilePath], S8.ByteString))]]

505 grouped = groupBy ((==) `on` fst) $ sortBy (comparing fst) next

507 grouped = groupBy ((==) `on` fst) $ sortBy (comparing fst) next

506− hoisted :: [(T.Text, [([T.Text], S8.ByteString)])]

508+ hoisted :: [(FilePath, [([FilePath], S8.ByteString)])]

507 hoisted = map (fst . head &&& map snd) grouped

509 hoisted = map (fst . head &&& map snd) grouped

508− go' :: [([T.Text], S8.ByteString)] -> EmbeddedEntry

510+ go' :: [([FilePath], S8.ByteString)] -> EmbeddedEntry

509 go' [([], content)] = EEFile content

511 go' [([], content)] = EEFile content

510 go' x = EEFolder $ go $ filter (\y -> not $ null $ fst y) x

512 go' x = EEFolder $ go $ filter (\y -> not $ null $ fst y) x

511

513

512−bsToFile :: T.Text -> S8.ByteString -> File

514+bsToFile :: FilePath -> S8.ByteString -> File

513bsToFile name bs = File

515bsToFile name bs = File

514 { fileGetSize = S8.length bs

516 { fileGetSize = S8.length bs

515 , fileToResponse = \s h -> W.ResponseBuilder s h $ fromByteString bs

517 , fileToResponse = \s h -> W.ResponseBuilder s h $ fromByteString bs

@@ -525,13 +527,7 @@ runHashL :: L.ByteString -> ByteString

525runHashL = B64.encode . MD5.hashlazy

527runHashL = B64.encode . MD5.hashlazy

526

528

527staticApp :: StaticSettings -> W.Application

529staticApp :: StaticSettings -> W.Application

528−staticApp set req = staticAppPieces set (map toPiece $ W.pathInfo req) req

530+staticApp set req = staticAppPieces set (map FilePath $ W.pathInfo req) req

529−

530−toPiece :: T.Text -> Piece

531−toPiece t = Piece

532− { piecePretty = t

533− , pieceRaw = unfixPathName $ T.unpack t

534− }

535

531

536status304, statusNotModified :: H.Status

532status304, statusNotModified :: H.Status

537status304 = H.Status 304 "Not Modified"

533status304 = H.Status 304 "Not Modified"

@@ -559,7 +555,7 @@ staticAppPieces ss pieces req = liftIO $ do

559 let indices = ssIndices ss

555 let indices = ssIndices ss

560 case checkSpecialDirListing pieces of

556 case checkSpecialDirListing pieces of

561 Just res -> response res

557 Just res -> response res

562− Nothing -> checkPieces (ssFolder ss) indices pieces req (ssMaxAge ss) (ssUseHash ss) >>= response

558+ Nothing -> checkPieces (ssFolder ss) (map FilePath indices) pieces req (ssMaxAge ss) (ssUseHash ss) >>= response

563 where

559 where

564 response cp = case cp of

560 response cp = case cp of

565 FileResponse file ch -> do

561 FileResponse file ch -> do

@@ -573,7 +569,7 @@ staticAppPieces ss pieces req = liftIO $ do

573 return $ W.responseLBS statusNotModified

569 return $ W.responseLBS statusNotModified

574 [ ("Content-Type", "text/plain")

570 [ ("Content-Type", "text/plain")

575 ] "Not Modified"

571 ] "Not Modified"

576− DirectoryResponse fp ->

572+ DirectoryResponse fp -> do

577 case ssListing ss of

573 case ssListing ss of

578 (Just f) -> do

574 (Just f) -> do

579 lbs <- f pieces fp

575 lbs <- f pieces fp

@@ -591,7 +587,7 @@ staticAppPieces ss pieces req = liftIO $ do

591 ] lbs

587 ] lbs

592

588

593 Redirect pieces' mHash -> do

589 Redirect pieces' mHash -> do

594− let loc = (ssMkRedirect ss) pieces' $ toByteString (H.encodePathSegments $ map piecePretty pieces')

590+ let loc = (ssMkRedirect ss) pieces' $ toByteString (H.encodePathSegments $ map unFilePath pieces')

595 let qString = case mHash of

591 let qString = case mHash of

596 Just hash -> replace "etag" (Just hash) (W.queryString req)

592 Just hash -> replace "etag" (Just hash) (W.queryString req)

597 Nothing -> remove "etag" (W.queryString req)

593 Nothing -> remove "etag" (W.queryString req)

@@ -617,34 +613,34 @@ case for fixPathName/unfixPathName. I'm starting to use John

617Millikin's system-filepath package for some stuff with work, and might

613Millikin's system-filepath package for some stuff with work, and might

618consider migrating over to it for this in the future.

614consider migrating over to it for this in the future.

619-}

615-}

620−fixPathName :: FilePath -> FilePath

616+toFilePath :: Prelude.FilePath -> FilePath

621#if defined(mingw32_HOST_OS)

617#if defined(mingw32_HOST_OS)

622−fixPathName = id

618+toFilePath = FilePath . T.pack

623#else

619#else

624−fixPathName = T.unpack . TE.decodeUtf8With TEE.lenientDecode . S8.pack

620+toFilePath = FilePath . TE.decodeUtf8With TEE.lenientDecode . S8.pack

625#endif

621#endif

626

622

627−unfixPathName :: FilePath -> FilePath

623+fromFilePath :: FilePath -> Prelude.FilePath

628#if defined(mingw32_HOST_OS)

624#if defined(mingw32_HOST_OS)

629−unfixPathName = id

625+fromFilePath = T.unpack . unFilePath

630#else

626#else

631−unfixPathName = S8.unpack . TE.encodeUtf8 . T.pack

627+fromFilePath = S8.unpack . TE.encodeUtf8 . unFilePath

632#endif

628#endif

633

629

634-- Code below taken from Happstack: http://patch-tag.com/r/mae/happstack/snapshot/current/content/pretty/happstack-server/src/Happstack/Server/FileServe/BuildingBlocks.hs

630-- Code below taken from Happstack: http://patch-tag.com/r/mae/happstack/snapshot/current/content/pretty/happstack-server/src/Happstack/Server/FileServe/BuildingBlocks.hs

635defaultListing :: Listing

631defaultListing :: Listing

636defaultListing pieces (Folder _ contents) = do

632defaultListing pieces (Folder _ contents) = do

637− let isTop = null pieces || pieces == [Piece "" ""]

633+ let isTop = null pieces || pieces == [""]

638 let fps'' :: [Either Folder File]

634 let fps'' :: [Either Folder File]

639 fps'' = (if isTop then id else (Left (Folder ".." []) :)) contents

635 fps'' = (if isTop then id else (Left (Folder ".." []) :)) contents

640 return $ HU.renderHtml

636 return $ HU.renderHtml

641 $ H.html $ do

637 $ H.html $ do

642 H.head $ do

638 H.head $ do

643− let title = T.unpack $ T.intercalate "/" $ map piecePretty pieces

639+ let title = T.unpack $ T.intercalate "/" $ map unFilePath pieces

644 let title' = if null title then "root folder" else title

640 let title' = if null title then "root folder" else title

645 H.title $ H.toHtml title'

641 H.title $ H.toHtml title'

646 H.style $ H.toHtml $ unlines [ "table { margin: 0 auto; width: 760px; border-collapse: collapse; font-family: 'sans-serif'; }"

642 H.style $ H.toHtml $ unlines [ "table { margin: 0 auto; width: 760px; border-collapse: collapse; font-family: 'sans-serif'; }"

647− , "table, th, td { border: 1px solid #353948; }"

643+ , "table, th, td { border: 1px solid #353948; }"

648 , "td.size { text-align: right; font-size: 0.7em; width: 50px }"

644 , "td.size { text-align: right; font-size: 0.7em; width: 50px }"

649 , "td.date { text-align: right; font-size: 0.7em; width: 130px }"

645 , "td.date { text-align: right; font-size: 0.7em; width: 130px }"

650 , "td { padding-right: 1em; padding-left: 1em; }"

646 , "td { padding-right: 1em; padding-left: 1em; }"

@@ -658,7 +654,7 @@ defaultListing pieces (Folder _ contents) = do

658 , "a { text-decoration: none }"

654 , "a { text-decoration: none }"

659 ]

655 ]

660 H.body $ do

656 H.body $ do

661− H.h1 $ showFolder $ map piecePretty $ filter (not . T.null . piecePretty) pieces

657+ H.h1 $ showFolder $ map unFilePath $ filter (not . nullFilePath) pieces

662 renderDirectoryContentsTable haskellSrc folderSrc fps''

658 renderDirectoryContentsTable haskellSrc folderSrc fps''

663 where

659 where

664 image x = T.unpack $ T.concat [(relativeDirFromPieces pieces), ".hidden/", x, ".png"]

660 image x = T.unpack $ T.concat [(relativeDirFromPieces pieces), ".hidden/", x, ".png"]

@@ -709,7 +705,7 @@ renderDirectoryContentsTable haskellSrc folderSrc fps =

709 Right{} -> return ()

705 Right{} -> return ()

710 let name = either folderName fileName md

706 let name = either folderName fileName md

711 let isFile = either (const False) (const True) md

707 let isFile = either (const False) (const True) md

712− H.td (H.a ! A.href (H.toValue $ name `T.append` if isFile then "" else "/") $ H.toHtml name)

708+ H.td (H.a ! A.href (H.toValue $ unFilePath name `T.append` if isFile then "" else "/") $ H.toHtml $ unFilePath name)

713 H.td ! A.class_ "date" $ H.toHtml $

709 H.td ! A.class_ "date" $ H.toHtml $

714 case md of

710 case md of

715 Right File { fileGetModified = Just t } ->

711 Right File { fileGetModified = Just t } ->