git.iko.soy/typeable/wai
on master help sign in
Removed FIXMEs
307338dMichael Snoyman
Network/Wai/Application/Static.hs+18−56
compare with master
unifiedsplit
@@ -329,12 +329,6 @@ data Folder = Folder
329 , folderContents :: [Either Folder File] -- FIXME remove?
329 , folderContents :: [Either Folder File] -- FIXME remove?
330 }
330 }
331
331
332−data FolderEntry = FolderEntry -- FIXME remove
333− { feName :: T.Text
334− , feIsFile :: Bool
335− --, feGetMetaData :: IO (Maybe MetaData)
336− }
337−
338data File = File
332data File = File
339 { fileGetSize :: Int
333 { fileGetSize :: Int
340 , fileToResponse :: H.Status -> H.ResponseHeaders -> W.Response
334 , fileToResponse :: H.Status -> H.ResponseHeaders -> W.Response
@@ -374,24 +368,27 @@ defaultStaticSettings = StaticSettings
374 , ssMaxAge = MaxAgeSeconds $ 60 * 60
368 , ssMaxAge = MaxAgeSeconds $ 60 * 60
375 }
369 }
376
370
371+fileHelper :: FilePath -> T.Text -> IO File
372+fileHelper fp name = do
373+ fs <- getFileStatus fp
374+ return File
375+ { fileGetSize = fromIntegral $ fileSize fs
376+ , fileToResponse = \s h -> W.ResponseFile s h fp Nothing
377+ , fileName = name
378+ , fileGetHash = Just $ do
379+ -- FIXME replace lazy IO with enumerators
380+ -- FIXME let's use a dictionary to cache these values?
381+ l <- L.readFile fp
382+ return $ runHashL l
383+ , fileGetModified = Just $ modificationTime fs
384+ }
385+
377fileSystemLookup :: FilePath -> Pieces -> IO FileLookup
386fileSystemLookup :: FilePath -> Pieces -> IO FileLookup
378fileSystemLookup prefix pieces = do
387fileSystemLookup prefix pieces = do
379 let fp = pathFromPieces prefix pieces
388 let fp = pathFromPieces prefix pieces
380 fe <- doesFileExist fp
389 fe <- doesFileExist fp
381 if fe
390 if fe
382− then do
383− fs <- getFileStatus fp
384− return $ Just $ Right File
385− { fileGetSize = fromIntegral $ fileSize fs
386− , fileToResponse = \s h -> W.ResponseFile s h fp Nothing
387− , fileName = piecePretty $ last pieces
391+ then fmap (Just . Right) $ fileHelper fp (piecePretty $ last pieces)
388− , fileGetHash = Just $ do
389− -- FIXME replace lazy IO with enumerators
390− -- FIXME let's use a dictionary to cache these values?
391− l <- L.readFile fp
392− return $ runHashL l
393− , fileGetModified = Just $ modificationTime fs
394− }
395 else do
392 else do
396 de <- doesDirectoryExist fp
393 de <- doesDirectoryExist fp
397 if de
394 if de
@@ -404,19 +401,7 @@ fileSystemLookup prefix pieces = do
404 let fp' = fp ++ '/' : name
401 let fp' = fp ++ '/' : name
405 fe' <- doesFileExist fp'
402 fe' <- doesFileExist fp'
406 if fe'
403 if fe'
407− then do
404+ then fmap Right $ fileHelper fp' name'
408− fs <- getFileStatus fp'
409− return $ Right File
410− { fileGetSize = fromIntegral $ fileSize fs
411− , fileToResponse = \s h -> W.ResponseFile s h fp' Nothing
412− , fileName = name'
413− , fileGetHash = Just $ do
414− -- FIXME replace lazy IO with enumerators
415− -- FIXME let's use a dictionary to cache these values?
416− l <- L.readFile fp'
417− return $ runHashL l
418− , fileGetModified = Just $ modificationTime fs
419− }
420 else return $ Left $ Folder name' [])
405 else return $ Left $ Folder name' [])
421 return $ Just $ Left $ Folder (error "413") entries
406 return $ Just $ Left $ Folder (error "413") entries
422 else return Nothing
407 else return Nothing
@@ -543,14 +528,6 @@ staticAppPieces ss pieces req = liftIO $ do
543 Redirect pieces' -> do
528 Redirect pieces' -> do
544 let loc = (ssMkRedirect ss) pieces' $ toByteString (H.encodePathSegments $ map piecePretty pieces')
529 let loc = (ssMkRedirect ss) pieces' $ toByteString (H.encodePathSegments $ map piecePretty pieces')
545
530
546− {- FIXME seems unnecessary
547− let loc' =
548− -- relativeDirFromPieces pieces = T.concat $ map (const "../") (drop 1 pieces) -- last piece is not a dir
549− -- (ssMkRedirect ss) pieces' $ encodePathInfo pieces' []
550− toByteString $
551− foldr mappend (H.encodePathSegments $ map piecePretty pieces') -- FIXME is this correct?
552− $ map (const $ copyByteString "../") $ drop 1 pieces
553− -}
554 return $ W.responseLBS H.status301
531 return $ W.responseLBS H.status301
555 [ ("Content-Type", "text/plain")
532 [ ("Content-Type", "text/plain")
556 , ("Location", loc)
533 , ("Location", loc)
@@ -561,21 +538,6 @@ staticAppPieces ss pieces req = liftIO $ do
561 NotFound -> return $ W.responseLBS H.status404
538 NotFound -> return $ W.responseLBS H.status404
562 [ ("Content-Type", "text/plain")
539 [ ("Content-Type", "text/plain")
563 ] "File not found"
540 ] "File not found"
564− where
565− {-
566− -- expires header: formatTime "%a, %d-%b-%Y %X GMT"
567− setCacheHeaders :: CacheSettings -> File -> IO H.ResponseHeaders
568− setCacheHeaders (Forever isStaticFile) fp = return $
569− if isStaticFile fp (S8.drop 1 $ W.rawQueryString req)
570− then [("Cache-Control", S8.append "max-age=" $ S8.pack $ show oneYear)]
571− else []
572− setCacheHeaders NoCache _ = return []
573− setCacheHeaders (ETag ioLookup) fp = do
574− etag <- ioLookup fp
575− return $ case etag of
576− Just hash -> [("ETag", hash)]
577− Nothing -> []
578− -}
579
541
580{-
542{-
581The problem is that the System.Directory functions are a lie: they
543The problem is that the System.Directory functions are a lie: they
@@ -628,7 +590,7 @@ defaultListing pieces (Folder _ contents) = do
628 , "a { text-decoration: none }"
590 , "a { text-decoration: none }"
629 ]
591 ]
630 H.body $ do
592 H.body $ do
631− H.h1 $ showFolder $ map (T.unpack . piecePretty) $ filter (not . T.null . piecePretty) pieces -- FIXME don't unpack
593+ H.h1 $ showFolder $ map piecePretty $ filter (not . T.null . piecePretty) pieces
632 renderDirectoryContentsTable haskellSrc folderSrc fps''
594 renderDirectoryContentsTable haskellSrc folderSrc fps''
633 where
595 where
634 image x = T.unpack $ T.concat [(relativeDirFromPieces pieces), ".hidden/", x, ".png"]
596 image x = T.unpack $ T.concat [(relativeDirFromPieces pieces), ".hidden/", x, ".png"]