@@ -36,8 +36,10 @@ module Network.Wai.Application.Static
3636 , unfixPathName
3737 -- new stuff to be sorted
3838 , fileSystemLookup
39+ , embeddedLookup
3940 , defaultMkRedirect
4041 , File (..)
42+ , toEmbedded
4143 ) where
4244
4345import qualified Network.Wai as W
@@ -59,7 +61,7 @@ import qualified Text.Blaze.Html5 as H
5961import qualified Text.Blaze.Renderer.Utf8 as HU
6062import qualified Text.Blaze.Html5.Attributes as A
6163
62−import Blaze.ByteString.Builder (toByteString, copyByteString)
64+import Blaze.ByteString.Builder (toByteString, copyByteString, fromByteString)
6365import Data.Monoid (mappend)
6466
6567import Data.Time
@@ -73,6 +75,11 @@ import qualified Data.Text as T
7375import qualified Data.Text.Encoding as TE
7476import qualified Data.Text.Encoding.Error as TEE
7577
78+import Control.Arrow ((&&&), second)
79+import Data.List (groupBy, sortBy)
80+import Data.Function (on)
81+import Data.Ord (comparing)
82+
7683#ifdef PRINT
7784import Debug.Trace
7885debug :: (Show a) => a -> a
@@ -377,6 +384,72 @@ fileSystemLookup prefix pieces = do
377384 return $ FLFolder $ Folder entries
378385 else return FLDoesNotExist
379386
387+type Embedded = Map.Map T.Text EmbeddedEntry
388+
389+data EmbeddedEntry = EEFile S8.ByteString | EEFolder Embedded
390+
391+embeddedLookup :: Embedded -> Pieces -> IO FileLookup -- FIXME broken for unicode path names
392+embeddedLookup root pieces =
393+ return $ elookup pieces root
394+ where
395+ elookup [] x = FLFolder $ Folder $ map toEntry $ Map.toList x
396+ elookup (p:ps) x =
397+ case Map.lookup p x of
398+ Nothing -> FLDoesNotExist
399+ Just (EEFile f) ->
400+ case ps of
401+ [] -> FLFile $ bsToFile p f
402+ _ -> FLDoesNotExist
403+ Just (EEFolder y) -> elookup ps y
404+
405+toEntry :: (T.Text, EmbeddedEntry) -> FolderEntry
406+toEntry (name, ee) = FolderEntry
407+ { feName = name
408+ , feIsFile =
409+ case ee of
410+ EEFile{} -> True
411+ EEFolder{} -> False
412+ , feGetMetaData = return $ Just $
413+ case ee of
414+ EEFile bs -> FileMetaData
415+ { mdName = T.unpack name
416+ , mdModified = 0 -- FIXME
417+ , mdSize = fromIntegral $ S8.length bs
418+ }
419+ EEFolder _ -> FolderMetaData
420+ { mdName = T.unpack name
421+ }
422+ }
423+
424+toEmbedded :: [(FilePath, S8.ByteString)] -> Embedded
425+toEmbedded fps =
426+ go texts
427+ where
428+ texts = map (\(x, y) -> (filter (not . T.null) $ toPieces x, y)) fps
429+ toPieces "" = []
430+ toPieces x =
431+ let (y, z) = break (== '/') x
432+ in T.pack y : toPieces (drop 1 z)
433+ go :: [(Pieces, S8.ByteString)] -> Embedded
434+ go orig =
435+ Map.fromList $ map (second go') hoisted
436+ where
437+ next = map (\(x, y) -> (head x, (tail x, y))) orig
438+ grouped :: [[(T.Text, (Pieces, S8.ByteString))]]
439+ grouped = groupBy ((==) `on` fst) $ sortBy (comparing fst) next
440+ hoisted :: [(T.Text, [(Pieces, S8.ByteString)])]
441+ hoisted = map (fst . head &&& map snd) grouped
442+ go' :: [(Pieces, S8.ByteString)] -> EmbeddedEntry
443+ go' [([], content)] = EEFile content
444+ go' x = EEFolder $ go $ filter (\y -> not $ null $ fst y) x
445+
446+bsToFile :: T.Text -> S8.ByteString -> File
447+bsToFile name bs = File
448+ { fileGetSize = return $ S8.length bs
449+ , fileToResponse = \s h -> W.ResponseBuilder s h $ fromByteString bs
450+ , fileName = name
451+ }
452+
380453staticApp :: StaticSettings -> W.Application
381454staticApp set req = do
382455 let pieces = W.pathInfo req