{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, UndecidableInstances #-}moduleURLT.HappstackwhereimportControl.Applicative.Error(Failing(Failure,Success))importControl.Monad(MonadPlus(mzero))importControl.Monad.Trans(lift)importData.List(intersperse)importHappstack.Server(FilterMonad(..),ServerMonad(..),WebMonad(..),ServerPartT,Response,Request(rqPaths),ToMessage(..),dir,runServerPartT,withRequest)importURLT.Base(URLT(URLT),Link,mapURLT)importURLT.HandleT(Site,runSite)instance(ServerMonadm)=>ServerMonad(URLTurlm)whereaskRq=liftaskRqlocalRqfm=mapURLT(localRqf)minstance(FilterMonadam)=>FilterMonada(URLTurlm)wheresetFilter=lift.setFiltercomposeFilter=lift.composeFiltergetFilter=mapURLTgetFilterinstance(WebMonadam)=>WebMonada(URLTurlm)wherefinishWith=lift.finishWith-- FIXME: the prefix can only be a single directory right nowimplSite::(Monadm)=>String->String->SitelinkLink(ServerPartTm)a->ServerPartTmaimplSitedomainprefixsiteSpec=dir(filter(/='/')prefix)$withRequest$\rq->letlink=(concat(intersperse"/"(rqPathsrq)))indor<-runServerPartT(runSite(domain++prefix)siteSpeclink)(rq{rqPaths=[]})caserof(Failure_)->mzero(Successv)->returnv