{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE TemplateHaskell, CPP #-}-- | Static file serving for WAI.moduleNetwork.Wai.Application.Static(-- * WAI applicationstaticApp-- ** Settings,defaultWebAppSettings,webAppSettingsWithLookup,defaultFileServerSettings,StaticSettings,ssFolder,ssMkRedirect,ssGetMimeType,ssListing,ssIndices,ssMaxAge,ssRedirectToIndex-- * Generic, non-WAI code-- ** Mime types,MimeType,defaultMimeType-- ** Mime type by file extension,Extension,MimeMap,takeExtensions,defaultMimeTypes,mimeTypeByExt,defaultMimeTypeByExt-- ** Finding files,Pieces,pathFromPieces-- ** Directory listings,Listing,defaultListing-- ** Lookup functions,fileSystemLookup,fileSystemLookupHash,embeddedLookup-- ** Embedded,Embedded,EmbeddedEntry(..),toEmbedded-- ** Redirecting,defaultMkRedirect-- * Other data types,File(..),FilePath(..),toFilePath,fromFilePath,MaxAge(..),ETagLookup)whereimportPreludehiding(FilePath)importqualifiedPreludeimportqualifiedNetwork.WaiasWimportqualifiedNetwork.HTTP.TypesasHimportData.Map(Map)importqualifiedData.MapasMapimportData.ByteString(ByteString)importSystem.Directory(doesFileExist,doesDirectoryExist,getDirectoryContents)importqualifiedData.ByteString.Char8asS8importqualifiedData.ByteString.LazyasLimportData.ByteString.Lazy.Char8()importSystem.PosixCompat.Files(fileSize,getFileStatus,modificationTime)importSystem.Posix.Types(EpochTime)importControl.Monad.IO.Class(liftIO)importqualifiedCrypto.Hash.MD5asMD5importControl.Monad(forM)importControl.Exception(SomeException,try)importText.Blaze((!))importqualifiedText.Blaze.Html5asHimportqualifiedText.Blaze.Renderer.Utf8asHUimportqualifiedText.Blaze.Html5.AttributesasAimportBlaze.ByteString.Builder(toByteString,fromByteString)importData.TimeimportData.Time.Clock.POSIXimportSystem.Locale(defaultTimeLocale)importData.FileEmbed(embedFile)importData.Text(Text)importqualifiedData.TextasTimportqualifiedData.Text.EncodingasTEimportqualifiedData.Text.Encoding.ErrorasTEEimportControl.Arrow((&&&),second)importData.List(groupBy,sortBy,find,foldl')importData.Function(on)importData.Ord(comparing)importqualifiedData.ByteString.Base64asB64importData.Either(rights)importData.Maybe(isJust,fromJust)importNetwork.HTTP.Date(parseHTTPDate,epochTimeToHTTPDate,formatHTTPDate)importData.String(IsString(..))newtypeFilePath=FilePath{unFilePath::Text}deriving(Ord,Eq,Show)instanceIsStringFilePathwherefromString=toFilePath(</>)::FilePath->FilePath->FilePath(FilePatha)</>(FilePathb)=FilePath$T.concat[a,"/",b]-- | A list of all possible extensions, starting from the largest.takeExtensions::FilePath->[FilePath]takeExtensions(FilePaths)=caseT.break(=='.')sof(_,"")->[](_,x)->FilePath(T.drop1x):takeExtensions(FilePath$T.drop1x)typeMimeType=ByteStringtypeExtension=FilePathtypeMimeMap=MapExtensionMimeTypedefaultMimeType::MimeTypedefaultMimeType="application/octet-stream"-- taken from snap-core Snap.Util.FileServerdefaultMimeTypes::MimeMapdefaultMimeTypes=Map.fromList[("apk","application/vnd.android.package-archive"),("asc","text/plain"),("asf","video/x-ms-asf"),("asx","video/x-ms-asf"),("avi","video/x-msvideo"),("bz2","application/x-bzip"),("c","text/plain"),("class","application/octet-stream"),("conf","text/plain"),("cpp","text/plain"),("css","text/css"),("cxx","text/plain"),("dtd","text/xml"),("dvi","application/x-dvi"),("epub","application/epub+zip"),("gif","image/gif"),("gz","application/x-gzip"),("hs","text/plain"),("htm","text/html"),("html","text/html"),("ico","image/vnd.microsoft.icon"),("jar","application/x-java-archive"),("jpeg","image/jpeg"),("jpg","image/jpeg"),("js","text/javascript"),("json","application/json"),("log","text/plain"),("manifest","text/cache-manifest"),("m3u","audio/x-mpegurl"),("mov","video/quicktime"),("mp3","audio/mpeg"),("mpeg","video/mpeg"),("mpg","video/mpeg"),("ogg","application/ogg"),("pac","application/x-ns-proxy-autoconfig"),("pdf","application/pdf"),("png","image/png"),("bmp","image/bmp"),("ps","application/postscript"),("qt","video/quicktime"),("sig","application/pgp-signature"),("spl","application/futuresplash"),("svg","image/svg+xml"),("swf","application/x-shockwave-flash"),("tar","application/x-tar"),("tar.bz2","application/x-bzip-compressed-tar"),("tar.gz","application/x-tgz"),("tbz","application/x-bzip-compressed-tar"),("text","text/plain"),("tgz","application/x-tgz"),("torrent","application/x-bittorrent"),("ttf","application/x-font-truetype"),("txt","text/plain"),("wav","audio/x-wav"),("wax","audio/x-ms-wax"),("wma","audio/x-ms-wma"),("wmv","video/x-ms-wmv"),("xbm","image/x-xbitmap"),("xhtml","application/xhtml+xml"),("xml","text/xml"),("xpm","image/x-xpixmap"),("xwd","image/x-xwindowdump"),("zip","application/zip")]mimeTypeByExt::MimeMap->MimeType-- ^ default mime type->FilePath->MimeTypemimeTypeByExtmmdef=go.takeExtensionswherego[]=defgo(e:es)=caseMap.lookupemmofNothing->goesJustmt->mtdefaultMimeTypeByExt::FilePath->MimeTypedefaultMimeTypeByExt=mimeTypeByExtdefaultMimeTypesdefaultMimeTypedataCheckPieces=-- | Just the etag hash or Nothing for no etag hashRedirectPieces(MaybeByteString)|Forbidden|NotFound|FileResponseFileH.ResponseHeaders|NotModified|DirectoryResponseFolder-- TODO: add file size|SendContentMimeTypeL.ByteStringsafeInit::[a]->[a]safeInit[]=[]safeInitxs=initxsfilterButLast::(a->Bool)->[a]->[a]filterButLast_[]=[]filterButLast_[x]=[x]filterButLastf(x:xs)|fx=x:filterButLastfxs|otherwise=filterButLastfxsunsafe::FilePath->Boolunsafe(FilePaths)|T.nulls=False|T.heads=='.'=True|otherwise=T.any(=='/')snullFilePath::FilePath->BoolnullFilePath=T.null.unFilePath{-
stripTrailingSlash :: FilePath -> FilePath
stripTrailingSlash fp@(FilePath t)
| T.null t || T.last t /= '/' = fp
| otherwise = FilePath $ T.init t
-}typePieces=[FilePath]relativeDirFromPieces::Pieces->T.TextrelativeDirFromPiecespieces=T.concat$map(const"../")(drop1pieces)-- last piece is not a dirpathFromPieces::FilePath->Pieces->FilePathpathFromPieces=foldl'(</>)checkSpecialDirListing::Pieces->MaybeCheckPiecescheckSpecialDirListing[".hidden","folder.png"]=Just$SendContent"image/png"$L.fromChunks[$(embedFile"images/folder.png")]checkSpecialDirListing[".hidden","haskell.png"]=Just$SendContent"image/png"$L.fromChunks[$(embedFile"images/haskell.png")]checkSpecialDirListing_=NothingcheckPieces::(Pieces->IOFileLookup)-- ^ file lookup function->[FilePath]-- ^ List of default index files. Cannot contain slashes.->Pieces-- ^ parsed request->W.Request->MaxAge->Bool-- ^ use hash?->Bool-- ^ Redirect to Index?->IOCheckPiecescheckPiecesfileLookupindicespiecesreqmaxAgeuseHashredirectToIndex|anyunsafepieces=returnForbidden|anynullFilePath$safeInitpieces=return$Redirect(filterButLast(not.nullFilePath)pieces)Nothing|otherwise=dolet(isFile,isFolder)=case()of()|nullpieces->(True,True)|nullFilePath(lastpieces)->(False,True)|otherwise->(True,False)fl<-fileLookuppiecescase(fl,isFile)of(Nothing,_)->returnNotFound(Just(Rightfile),True)->handleCachefile(JustRight{},False)->return$Redirect(initpieces)Nothing(Just(Leftfolder@(Folder_contents)),_)->docasecheckIndices$mapfileName$rightscontentsofJustindex->ifredirectToIndexthenreturn$Redirect(setLastpiecesindex)NothingelsecheckPiecesfileLookupindices(setLastpiecesindex)reqmaxAgeuseHashredirectToIndexNothing->ifisFolderthenreturn$DirectoryResponsefolderelsereturn$Redirect(pieces++[""])Nothingwhereheaders=W.requestHeadersreqqueryString=W.queryStringreq-- HTTP caching has a cache control header that you can set an expire time for a resource.-- Max-Age is easiest because it is a simple number-- a cache-control asset will only be downloaded once (if the browser maintains its cache)-- and the server will never be contacted for the resource again (until it expires)---- A second caching mechanism is ETag and last-modified-- this form of caching is not as good as the static- the browser can avoid downloading the file, but it always need to send a request with the etag value or the last-modified value to the server to see if its copy is up to date---- We should set a cache control and one of ETag or last-modifed whenever possible---- In a Yesod web application we can append an etag parameter to static assets.-- This signals that both a max-age and ETag header should be set-- if there is no etag parameter-- * don't set the max-age-- * set ETag or last-modified-- * ETag must be calculated ahead of time.-- * last-modified is just the file mtime.handleCachefile=ifnotuseHashthenlastModifiedCachefileelsedoletetagParam=lookup"etag"queryStringcaseetagParamofNothing->do-- no query parameter. Set appropriate ETag headersmHash<-fileGetHashfilecasemHashofNothing->lastModifiedCachefileJusthash->caselookup"if-none-match"headersofJustlastHash->ifhash==lastHashthenreturnNotModifiedelsereturn$FileResponsefile$[("ETag",hash)]Nothing->return$FileResponsefile$[("ETag",hash)]JustmEtag->domHash<-fileGetHashfilecasemHashof-- a file used to have an etag parameter, but no longer doesNothing->return$RedirectpiecesNothingJusthash->ifisJustmEtag&&hash==fromJustmEtagthenreturn$FileResponsefile$("ETag",hash):cacheControlelsereturn$Redirectpieces(Justhash)lastModifiedCachefile=case(lookup"if-modified-since"headers>>=parseHTTPDate,fileGetModifiedfile)of(mLastSent,Justmodified)->doletmdate=epochTimeToHTTPDatemodifiedincasemLastSentofJustlastSent->iflastSent==mdatethenreturnNotModifiedelsereturn$FileResponsefile$[("last-modified",formatHTTPDatemdate)]Nothing->return$FileResponsefile$[("last-modified",formatHTTPDatemdate)]_->return$FileResponsefile[]setLast::Pieces->FilePath->PiecessetLast[]x=[x]setLast[""]x=[x]setLast(a:b)x=a:setLastbxcheckIndices::[FilePath]->MaybeFilePathcheckIndicescontents=find(flipelemindices)contentscacheControl=caseccIntofNothing->[]Justi->[("Cache-Control",S8.append"max-age="$S8.pack$showi)]whereccInt=casemaxAgeofNoMaxAge->NothingMaxAgeSecondsi->JustiMaxAgeForever->JustoneYearoneYear::IntoneYear=60*60*24*365typeListing=(Pieces->Folder->IOL.ByteString)typeFileLookup=Maybe(EitherFolderFile)dataFolder=Folder{folderName::FilePath,folderContents::[EitherFolderFile]}dataFile=File{fileGetSize::Int,fileToResponse::H.Status->H.ResponseHeaders->W.Response,fileName::FilePath,fileGetHash::IO(MaybeByteString),fileGetModified::MaybeEpochTime}dataStaticSettings=StaticSettings{ssFolder::Pieces->IOFileLookup-- TODO: not a folder, so rename,ssMkRedirect::Pieces->ByteString->ByteString,ssGetMimeType::File->IOMimeType,ssListing::MaybeListing,ssIndices::[T.Text]-- index.html,ssRedirectToIndex::Bool,ssMaxAge::MaxAge,ssUseHash::Bool}dataMaxAge=NoMaxAge|MaxAgeSecondsInt|MaxAgeForeverdefaultMkRedirect::Pieces->ByteString->S8.ByteStringdefaultMkRedirectpiecesnewPath|S8.nullnewPath||S8.nullrelDir||S8.lastrelDir/='/'||S8.headnewPath/='/'=relDir`S8.append`newPath|otherwise=relDir`S8.append`S8.tailnewPathwhererelDir=TE.encodeUtf8(relativeDirFromPiecespieces)webAppSettingsWithLookup::FilePath->ETagLookup->StaticSettingswebAppSettingsWithLookupdiretagLookup=defaultWebAppSettings{ssFolder=webAppLookupetagLookupdir}defaultWebAppSettings::StaticSettingsdefaultWebAppSettings=StaticSettings{ssFolder=webAppLookuphashFileIfExists"static",ssMkRedirect=defaultMkRedirect,ssGetMimeType=return.defaultMimeTypeByExt.fileName,ssMaxAge=MaxAgeForever,ssListing=Nothing,ssIndices=[],ssRedirectToIndex=False,ssUseHash=True}defaultFileServerSettings::StaticSettingsdefaultFileServerSettings=StaticSettings{ssFolder=fileSystemLookup"static",ssMkRedirect=defaultMkRedirect,ssGetMimeType=return.defaultMimeTypeByExt.fileName,ssMaxAge=MaxAgeSeconds$60*60,ssListing=JustdefaultListing,ssIndices=["index.html","index.htm"],ssRedirectToIndex=False,ssUseHash=False}fileHelper::ETagLookup->FilePath->FilePath->IO(MaybeFile)fileHelperhashFuncfpname=doefs<-try$getFileStatus$fromFilePathfpcaseefsofLeft(_::SomeException)->returnNothingRightfs->return$JustFile{fileGetSize=fromIntegral$fileSizefs,fileToResponse=\sh->W.ResponseFilesh(fromFilePathfp)Nothing,fileName=name,fileGetHash=hashFuncfp,fileGetModified=Just$modificationTimefs}typeETagLookup=(FilePath->IO(MaybeByteString))webAppLookup::ETagLookup->FilePath->Pieces->IOFileLookupwebAppLookupcachedLookupHashprefixpieces=domfile<-fileHelpercachedLookupHashfp(lastpieces)return$fmapRightmfilewherefp=pathFromPiecesprefixpiecesdefaultFileSystemHash::ETagLookupdefaultFileSystemHashfp=fmapJust$hashFilefp-- FIXME replace lazy IO with enumerators-- FIXME let's use a dictionary to cache these values?hashFile::FilePath->IOByteStringhashFilefp=dol<-L.readFile$fromFilePathfpreturn$runHashLlhashFileIfExists::ETagLookuphashFileIfExistsfp=dofe<-doesFileExist$fromFilePathfpiffethenreturnNothingelsedefaultFileSystemHashfpfileSystemLookup::FilePath->Pieces->IOFileLookupfileSystemLookup=fileSystemLookupHashdefaultFileSystemHashfileSystemLookupHash::ETagLookup->FilePath->Pieces->IOFileLookupfileSystemLookupHashhashFuncprefixpieces=doletfp=pathFromPiecesprefixpiecesfe<-doesFileExist$fromFilePathfpiffethen(fmap.fmap)Right$fileHelperhashFuncfp$lastpieceselsedode<-doesDirectoryExist$fromFilePathfpifdethendoletisVisible('.':_)=FalseisVisible""=FalseisVisible_=Trueentries'<-fmap(filterisVisible)$getDirectoryContents(fromFilePathfp)entries<-forMentries'$\nameRaw->doletname=toFilePathnameRawletfp'=fp</>namemfile'<-fileHelperhashFuncfp'namecasemfile'ofNothing->return$Left$Foldername[]Justfile'->return$Rightfile'return$Just$Left$Folder(error"Network.Wai.Application.Static.fileSystemLookup")entrieselsereturnNothingtypeEmbedded=Map.MapFilePathEmbeddedEntrydataEmbeddedEntry=EEFileS8.ByteString|EEFolderEmbeddedembeddedLookup::Embedded->Pieces->IOFileLookupembeddedLookuprootpieces=return$elookup"<root>"piecesrootwhereelookup::FilePath->[FilePath]->Embedded->FileLookupelookupp[]x=Just$Left$Folderp$maptoEntry$Map.toListxelookupp[""]x=elookupp[]xelookup_(p:ps)x=caseMap.lookuppxofNothing->NothingJust(EEFilef)->casepsof[]->Just$Right$bsToFilepf_->NothingJust(EEFoldery)->elookupppsytoEntry::(FilePath,EmbeddedEntry)->EitherFolderFiletoEntry(name,EEFolder{})=Left$Foldername[]toEntry(name,EEFilebs)=Right$File{fileGetSize=S8.lengthbs,fileToResponse=\sh->W.ResponseBuildersh$fromByteStringbs,fileName=name,fileGetHash=return$Just$runHashbs,fileGetModified=Nothing}toEmbedded::[(Prelude.FilePath,S8.ByteString)]->EmbeddedtoEmbeddedfps=gotextswheretexts=map(\(x,y)->(filter(not.T.null.unFilePath)$toPiecesx,y))fpstoPieces""=[]toPiecesx=let(y,z)=break(=='/')xintoFilePathy:toPieces(drop1z)go::[([FilePath],S8.ByteString)]->Embeddedgoorig=Map.fromList$map(secondgo')hoistedwherenext=map(\(x,y)->(headx,(tailx,y)))origgrouped::[[(FilePath,([FilePath],S8.ByteString))]]grouped=groupBy((==)`on`fst)$sortBy(comparingfst)nexthoisted::[(FilePath,[([FilePath],S8.ByteString)])]hoisted=map(fst.head&&&mapsnd)groupedgo'::[([FilePath],S8.ByteString)]->EmbeddedEntrygo'[([],content)]=EEFilecontentgo'x=EEFolder$go$filter(\y->not$null$fsty)xbsToFile::FilePath->S8.ByteString->FilebsToFilenamebs=File{fileGetSize=S8.lengthbs,fileToResponse=\sh->W.ResponseBuildersh$fromByteStringbs,fileName=name,fileGetHash=return$Just$runHashbs,fileGetModified=Nothing}runHash::S8.ByteString->S8.ByteStringrunHash=B64.encode.MD5.hashrunHashL::L.ByteString->ByteStringrunHashL=B64.encode.MD5.hashlazystaticApp::StaticSettings->W.ApplicationstaticAppsetreq=staticAppPiecesset(mapFilePath$W.pathInforeq)reqstatus304,statusNotModified::H.Statusstatus304=H.Status304"Not Modified"statusNotModified=status304-- alist helper functionsreplace::Eqa=>a->b->[(a,b)]->[(a,b)]replacekv[]=[(k,v)]replacekv(x:xs)|fstx==k=(k,v):xs|otherwise=x:replacekvxsremove::Eqa=>a->[(a,b)]->[(a,b)]remove_[]=[]removek(x:xs)|fstx==k=xs|otherwise=x:removekxsstaticAppPieces::StaticSettings->Pieces->W.ApplicationstaticAppPieces__req|W.requestMethodreq/="GET"=return$W.responseLBSH.status405[("Content-Type","text/plain")]"Only GET is supported"staticAppPiecessspiecesreq=liftIO$doletindices=ssIndicessscasecheckSpecialDirListingpiecesofJustres->responseresNothing->checkPieces(ssFolderss)(mapFilePathindices)piecesreq(ssMaxAgess)(ssUseHashss)(ssRedirectToIndexss)>>=responsewhereresponsecp=casecpofFileResponsefilech->domimetype<-ssGetMimeTypessfileletfilesize=fileGetSizefileletheaders=("Content-Type",mimetype):("Content-Length",S8.pack$showfilesize):chreturn$fileToResponsefileH.status200headersNotModified->return$W.responseLBSstatusNotModified[("Content-Type","text/plain")]"Not Modified"DirectoryResponsefp->docasessListingssof(Justf)->dolbs<-fpiecesfpreturn$W.responseLBSH.status200[("Content-Type","text/html; charset=utf-8")]lbsNothing->return$W.responseLBSH.status403[("Content-Type","text/plain")]"Directory listings disabled"SendContentmtlbs->do-- TODO: set caching headersreturn$W.responseLBSH.status200[("Content-Type",mt)-- TODO: set Content-Length]lbsRedirectpieces'mHash->doletloc=(ssMkRedirectss)pieces'$toByteString(H.encodePathSegments$mapunFilePathpieces')letqString=casemHashofJusthash->replace"etag"(Justhash)(W.queryStringreq)Nothing->remove"etag"(W.queryStringreq)return$W.responseLBSH.status301[("Content-Type","text/plain"),("Location",S8.appendloc$H.renderQueryTrueqString)]"Redirect"Forbidden->return$W.responseLBSH.status403[("Content-Type","text/plain")]"Forbidden"NotFound->return$W.responseLBSH.status404[("Content-Type","text/plain")]"File not found"-- | System.Directory functions are a lie:-- they claim to be using String, but it's really just a raw byte sequence.-- We're assuming that non-Windows systems use UTF-8 encoding (there was-- a discussion regarding this, it wasn't an arbitrary decision). So we-- need to encode/decode the byte sequence to/from UTF8. That's the use-- case for fixPathName/unfixPathName. I'm starting to use John-- Millikin's system-filepath package for some stuff with work, and might-- consider migrating over to it for this in the future.toFilePath::Prelude.FilePath->FilePath#if defined(mingw32_HOST_OS)toFilePath=FilePath.T.pack#elsetoFilePath=FilePath.TE.decodeUtf8WithTEE.lenientDecode.S8.pack#endiffromFilePath::FilePath->Prelude.FilePath#if defined(mingw32_HOST_OS)fromFilePath=T.unpack.unFilePath#elsefromFilePath=S8.unpack.TE.encodeUtf8.unFilePath#endif-- Code below taken from Happstack: http://patch-tag.com/r/mae/happstack/snapshot/current/content/pretty/happstack-server/src/Happstack/Server/FileServe/BuildingBlocks.hsdefaultListing::ListingdefaultListingpieces(Folder_contents)=doletisTop=nullpieces||pieces==[""]letfps''::[EitherFolderFile]fps''=(ifisTopthenidelse(Left(Folder".."[]):))contentsreturn$HU.renderHtml$H.html$doH.head$dolettitle=T.unpack$T.intercalate"/"$mapunFilePathpieceslettitle'=ifnulltitlethen"root folder"elsetitleH.title$H.toHtmltitle'H.style$H.toHtml$unlines["table { margin: 0 auto; width: 760px; border-collapse: collapse; font-family: 'sans-serif'; }","table, th, td { border: 1px solid #353948; }","td.size { text-align: right; font-size: 0.7em; width: 50px }","td.date { text-align: right; font-size: 0.7em; width: 130px }","td { padding-right: 1em; padding-left: 1em; }","th.first { background-color: white; width: 24px }","td.first { padding-right: 0; padding-left: 0; text-align: center }","tr { background-color: white; }","tr.alt { background-color: #A3B5BA}","th { background-color: #3C4569; color: white; font-size: 1.125em; }","h1 { width: 760px; margin: 1em auto; font-size: 1em; font-family: sans-serif }","img { width: 20px }","a { text-decoration: none }"]H.body$doH.h1$showFolder$mapunFilePath$filter(not.nullFilePath)piecesrenderDirectoryContentsTablehaskellSrcfolderSrcfps''whereimagex=T.unpack$T.concat[(relativeDirFromPiecespieces),".hidden/",x,".png"]folderSrc=image"folder"haskellSrc=image"haskell"showName""="root"showNamex=xshowFolder[]="/"showFolder[x]=H.toHtml$showNamexshowFolder(x:xs)=dolethref=concat$replicate(lengthxs)"../"::StringH.a!A.href(H.toValuehref)$H.toHtml$showNamex" / "::H.HtmlshowFolderxs-- | a function to generate an HTML table showing the contents of a directory on the disk---- This function generates most of the content of the-- 'renderDirectoryContents' page. If you want to style the page-- differently, or add google analytics code, etc, you can just create-- a new page template to wrap around this HTML.---- see also: 'getMetaData', 'renderDirectoryContents'renderDirectoryContentsTable::String->String->[EitherFolderFile]->H.HtmlrenderDirectoryContentsTablehaskellSrcfolderSrcfps=H.table$doH.thead$doH.th!(A.class_"first")$H.img!(A.src$H.toValuehaskellSrc)H.th"Name"H.th"Modified"H.th"Size"H.tbody$mapM_mkRow(zip(sortBysortMDfps)$cycle[False,True])wheresortMD::EitherFolderFile->EitherFolderFile->OrderingsortMDLeft{}Right{}=LTsortMDRight{}Left{}=GTsortMD(Lefta)(Leftb)=compare(folderNamea)(folderNameb)sortMD(Righta)(Rightb)=compare(fileNamea)(fileNameb)mkRow::(EitherFolderFile,Bool)->H.HtmlmkRow(md,alt)=(ifaltthen(!A.class_"alt")elseid)$H.tr$doH.td!A.class_"first"$casemdofLeft{}->H.img!A.src(H.toValuefolderSrc)!A.alt"Folder"Right{}->return()letname=eitherfolderNamefileNamemdletisFile=either(constFalse)(constTrue)mdH.td(H.a!A.href(H.toValue$unFilePathname`T.append`ifisFilethen""else"/")$H.toHtml$unFilePathname)H.td!A.class_"date"$H.toHtml$casemdofRightFile{fileGetModified=Justt}->formatCalendarTimedefaultTimeLocale"%d-%b-%Y %X"t_->""H.td!A.class_"size"$H.toHtml$casemdofRightFile{fileGetSize=s}->prettyShowsLeft{}->""formatCalendarTimeabc=formatTimeab$posixSecondsToUTCTime(realToFracc::POSIXTime)prettyShowx|x>1024=prettyShowK$x`div`1024|otherwise=addCommas"B"xprettyShowKx|x>1024=prettyShowM$x`div`1024|otherwise=addCommas"KB"xprettyShowMx|x>1024=prettyShowG$x`div`1024|otherwise=addCommas"MB"xprettyShowGx=addCommas"GB"xaddCommass=(++(' ':s)).reverse.addCommas'.reverse.showaddCommas'(a:b:c:d:e)=a:b:c:',':addCommas'(d:e)addCommas'x=x