-- code structure written by John MacFarlane, -- I filled in some missing pieces and make it compile.moduleHack.Handler.Happstack(run,runWithConfig,ServerConf(..),appToServerPart)whereimportControl.Arrow((>>>))importControl.Monad.StateimportData.CharimportData.DefaultimportData.ListimportData.MaybeimportHackhiding(serverName)importqualifiedHackasHackimportHappstack.Server.SimpleHTTPasHappstackhiding(port,escape)importNetwork.URI(escapeURIString,isAllowedInURI)importControl.ApplicativeimportqualifiedData.ByteString.Char8asSimportqualifiedData.MapasMimportqualifiedHappstack.Server.SimpleHTTPasHdataServerConf=ServerConf{port::Int,serverName::String}deriving(Show)instanceDefaultServerConfwheredef=ServerConf{port=3000,serverName="localhost"}runWithConfig::ServerConf->Application->IO()runWithConfigconf=simpleHTTPnullConf{H.port=portconf}.appToServerPartconfrun::Application->IO()run=runWithConfigdefappToServerPart::ServerConf->Application->ServerPart(Happstack.Response)appToServerPartconfapp=askRq>>=liftIO.(hackRToServerPartR<$>).app.reqToEnvwherereqToEnvreq=def{requestMethod=convertRequestMethod$rqMethodreq,scriptName="",pathInfo=escape$"/"++(intercalate"/"$rqPathsreq),queryString=escape$dropWhile(=='?')$rqQueryreq,Hack.serverName=serverNameconf,serverPort=(snd$rqPeerreq),http=headersToHttp(rqHeadersreq),hackInput=(\(Bodyx)->x)(rqBodyreq),remoteHost=(fst$rqPeerreq)}escape=escapeURIStringisAllowedInURIconvertRequestMethodHappstack.OPTIONS=Hack.OPTIONSconvertRequestMethodHappstack.GET=Hack.GETconvertRequestMethodHappstack.HEAD=Hack.HEADconvertRequestMethodHappstack.POST=Hack.POSTconvertRequestMethodHappstack.PUT=Hack.PUTconvertRequestMethodHappstack.DELETE=Hack.DELETEconvertRequestMethodHappstack.TRACE=Hack.TRACEconvertRequestMethodHappstack.CONNECT=Hack.CONNECTheadersToHttp::Headers->[(String,String)]headersToHttp=M.toList>>>mapsnd>>>mapheaderToPairwhereheaderToPair(HeaderPairkv)=(normalizeHeader$S.unpackk,intercalate" "$mapS.unpackv)hackRToServerPartR::Hack.Response->Happstack.ResponsehackRToServerPartRr=Happstack.Response{rsCode=statusr,rsHeaders=httpToHeaders$headersr,rsFlags=RsFlags{rsfContentLength=False},rsBody=bodyr,rsValidator=Nothing}httpToHeaders::[(String,String)]->HeadershttpToHeaders=mappairToHeader>>>M.fromListwherepairToHeader(k,v)=((S.pack$maptoLowerk),HeaderPair(S.packk)[S.packv])-- happstack converts all request header to lowercase ...-- so we need to convert it back ...normalizeHeader::String->StringnormalizeHeaders=fromMaybes$find(maptoLower>>>(==s))headerListheaderList::[String]headerList=["Cache-Control","Connection","Date","Pragma","Transfer-Encoding","Upgrade","Via","Accept","Accept-Charset","Accept-Encoding","Accept-Language","Authorization","Cookie","Expect","From","Host","If-Modified-Since","If-Match","If-None-Match","If-Range","If-Unmodified-Since","Max-Forwards","Proxy-Authorization","Range","Referer","User-Agent","Age","Location","Proxy-Authenticate","Public","Retry-After","Server","Set-Cookie","TE","Trailer","Vary","Warning","WWW-Authenticate","Allow","Content-Base","Content-Encoding","Content-Language","Content-Length","Content-Location","Content-MD5","Content-Range","Content-Type","ETag","Expires","Last-Modified","Content-Transfer-Encodeing"]