diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs index 46ef947c..0d6cd14c 100644 --- a/Yesod/Handler.hs +++ b/Yesod/Handler.hs @@ -26,6 +26,7 @@ module Yesod.Handler --, ToHandler (..) -- * Special handlers , redirect + , sendFile , notFound , permissionDenied , invalidArgs @@ -37,7 +38,6 @@ module Yesod.Handler import Yesod.Request import Yesod.Response -import Yesod.Rep import Yesod.Template import Web.Mime @@ -140,6 +140,9 @@ errorResponse er = Handler $ \_ -> return ([], HCError er) redirect :: RedirectType -> String -> Handler yesod a redirect rt = specialResponse . Redirect rt +sendFile :: ContentType -> FilePath -> Handler yesod a +sendFile ct = specialResponse . SendFile ct + -- | Return a 404 not found page. Also denotes no handler available. notFound :: Handler yesod a notFound = errorResponse NotFound diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs index 6d9a91a1..83a98fc0 100644 --- a/Yesod/Helpers/Static.hs +++ b/Yesod/Helpers/Static.hs @@ -24,13 +24,13 @@ module Yesod.Helpers.Static import qualified Data.ByteString.Lazy as B import System.Directory (doesFileExist) -import Control.Applicative ((<$>)) import Control.Monad import Yesod import Data.List (intercalate) -type FileLookup = FilePath -> IO (Maybe B.ByteString) +-- FIXME this type is getting ugly... +type FileLookup = FilePath -> IO (Maybe (Either FilePath B.ByteString)) -- | A 'FileLookup' for files in a directory. Note that this function does not -- check if the requested path does unsafe things, eg expose hidden files. You @@ -43,7 +43,7 @@ fileLookupDir dir fp = do let fp' = dir ++ '/' : fp exists <- doesFileExist fp' if exists - then Just <$> B.readFile fp' -- FIXME replace lazy I/O when possible + then return $ Just $ Left fp' else return Nothing serveStatic :: FileLookup -> Verb -> [String] @@ -58,7 +58,8 @@ getStatic fl fp' = do content <- liftIO $ fl fp case content of Nothing -> notFound - Just bs -> return [(typeByExt $ ext fp, cs bs)] + Just (Left fp'') -> sendFile (typeByExt $ ext fp'') fp'' + Just (Right bs) -> return [(typeByExt $ ext fp, cs bs)] where isUnsafe [] = True isUnsafe ('.':_) = True diff --git a/Yesod/Rep.hs b/Yesod/Rep.hs index 10c44861..a8facc6a 100644 --- a/Yesod/Rep.hs +++ b/Yesod/Rep.hs @@ -32,7 +32,6 @@ module Yesod.Rep , Template (..) , TemplateFile (..) , Static (..) - , StaticFile (..) #if TEST , testSuite #endif @@ -40,7 +39,6 @@ module Yesod.Rep import Data.ByteString.Lazy (ByteString) import Data.Text.Lazy (Text) -import qualified Data.ByteString.Lazy as BL import Web.Mime #if TEST @@ -102,19 +100,6 @@ data Static = Static ContentType ByteString instance HasReps Static where chooseRep (Static ct bs) _ = return (ct, Content $ const $ return bs) -data StaticFile = StaticFile ContentType FilePath -instance HasReps StaticFile where - chooseRep (StaticFile ct fp) _ = do - bs <- BL.readFile fp - return (ct, Content $ const $ return bs) - --- Useful instances of HasReps -instance HasReps HtmlObject where - chooseRep = defChooseRep - [ (TypeHtml, return . cs . unHtmlDoc . cs) - , (TypeJson, return . cs . unJsonDoc . cs) - ] - #if TEST caseChooseRepHO :: Assertion caseChooseRepHO = do diff --git a/Yesod/Response.hs b/Yesod/Response.hs index cc37d40b..621ebbfb 100644 --- a/Yesod/Response.hs +++ b/Yesod/Response.hs @@ -47,6 +47,7 @@ import Data.Maybe (mapMaybe) import Data.ByteString.Lazy (ByteString) import Data.Text.Lazy (Text) import Yesod.Definitions +import Data.Object.Json import Web.Encodings (formatW3) import qualified Hack @@ -61,7 +62,6 @@ import Data.Object.Html import Test.Framework (testGroup, Test) #endif -import Data.Convertible.Text (cs) import Web.Mime newtype Content = Content { unContent :: [Language] -> IO ByteString } @@ -79,8 +79,7 @@ instance ConvertSuccess XmlDoc Content where type ChooseRep = [ContentType] -> IO (ContentType, Content) --- | Any type which can be converted to representations. There must be at least --- one representation for each type. +-- | Any type which can be converted to representations. class HasReps a where chooseRep :: a -> ChooseRep @@ -114,6 +113,13 @@ instance HasReps [(ContentType, Content)] where (x:_) -> x _ -> error "chooseRep [(ContentType, Content)] of empty" +-- FIXME remove this instance? only good for debugging, maybe special debugging newtype? +instance HasReps HtmlObject where + chooseRep = defChooseRep + [ (TypeHtml, return . cs . unHtmlDoc . cs) + , (TypeJson, return . cs . unJsonDoc . cs) + ] + data Response = Response Int [Header] ContentType Content -- | Different types of redirects. diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index daa9f15d..72abfd8b 100644 --- a/Yesod/Yesod.hs +++ b/Yesod/Yesod.hs @@ -6,7 +6,6 @@ module Yesod.Yesod , toHackApp ) where -import Yesod.Rep import Data.Object.Html (toHtmlObject) import Yesod.Response import Yesod.Request