Added embed, other minor fixes

This commit is contained in:
Michael Snoyman 2011-07-15 12:05:54 +03:00
parent 08f284c096
commit 2297fc1fb6
2 changed files with 27 additions and 4 deletions

View File

@ -30,7 +30,7 @@ module Yesod.Static
, StaticRoute (..) , StaticRoute (..)
-- * Smart constructor -- * Smart constructor
, static , static
-- FIXME add embed , embed
-- * Template Haskell helpers -- * Template Haskell helpers
, staticFiles , staticFiles
-- * Hashing -- * Hashing
@ -40,6 +40,7 @@ module Yesod.Static
import System.Directory import System.Directory
--import qualified System.Time --import qualified System.Time
import Control.Monad import Control.Monad
import Data.FileEmbed (embedDir)
import Yesod.Handler import Yesod.Handler
import Yesod.Core import Yesod.Core
@ -58,12 +59,18 @@ import Data.Monoid (mempty)
import qualified Data.Map as M import qualified Data.Map as M
--import Data.IORef (readIORef, newIORef, writeIORef) --import Data.IORef (readIORef, newIORef, writeIORef)
import Network.Wai (pathInfo) import Network.Wai (pathInfo)
import Data.Char (isLower, isDigit)
import Network.Wai.Application.Static import Network.Wai.Application.Static
( StaticSettings (..) ( StaticSettings (..)
, defaultWebAppSettings , defaultWebAppSettings
, fileSystemLookup , fileSystemLookup
, staticApp , staticApp
, embeddedLookup
, toEmbedded
, pathFromPieces
, toPiece
, fixPathName
) )
newtype Static = Static StaticSettings newtype Static = Static StaticSettings
@ -79,6 +86,14 @@ static fp =
ssFolder = fileSystemLookup fp ssFolder = fileSystemLookup fp
} }
-- | Produces a 'Static' based on embedding file contents in the executable at
-- compile time.
embed :: FilePath -> Q Exp
embed fp =
[|Static (defaultWebAppSettings
{ ssFolder = embeddedLookup (toEmbedded $(embedDir fp))
})|]
{- {-
publicProduction :: String -> FilePath -> IO Public publicProduction :: String -> FilePath -> IO Public
publicProduction root fp = do publicProduction root fp = do
@ -196,7 +211,14 @@ mkStaticFiles' fp routeConName makeHash = do
| '0' <= c && c <= '9' = c | '0' <= c && c <= '9' = c
| otherwise = '_' | otherwise = '_'
mkRoute f = do mkRoute f = do
let name = mkName $ intercalate "_" $ map (map replace') f let name' = intercalate "_" $ map (map replace') f
name = mkName $
case () of
()
| null name' -> error "null-named file"
| isDigit (head name') -> '_' : name'
| isLower (head name') -> name'
| otherwise -> '_' : name'
f' <- [|map pack $(lift f)|] f' <- [|map pack $(lift f)|]
let route = mkName routeConName let route = mkName routeConName
pack' <- [|pack|] pack' <- [|pack|]
@ -252,7 +274,7 @@ getStaticHandler static toSubR pieces = do
where route = StaticRoute pieces [] where route = StaticRoute pieces []
toSub _ = static toSub _ = static
staticSite = getSubSite :: Site (Route Static) (String -> Maybe (GHandler Static y ChooseRep)) staticSite = getSubSite :: Site (Route Static) (String -> Maybe (GHandler Static y ChooseRep))
handler = fromMaybe notFound $ handleSite staticSite undefined route "GET" handler = fromMaybe notFound $ handleSite staticSite (error "Yesod.Static: getSTaticHandler") route "GET"
-} -}
@ -267,4 +289,4 @@ calcHash fname =
-- FIXME Greg: Is this correct? Where is this function supposed to be? -- FIXME Greg: Is this correct? Where is this function supposed to be?
pathFromRawPieces :: FilePath -> [String] -> FilePath pathFromRawPieces :: FilePath -> [String] -> FilePath
pathFromRawPieces = undefined pathFromRawPieces fp = pathFromPieces fp . map (toPiece . pack . fixPathName)

View File

@ -30,6 +30,7 @@ library
, wai-app-static >= 0.3 && < 0.4 , wai-app-static >= 0.3 && < 0.4
, wai >= 0.4 && < 0.5 , wai >= 0.4 && < 0.5
, text >= 0.5 && < 1.0 , text >= 0.5 && < 1.0
, file-embed >= 0.0.4.1 && < 0.5
exposed-modules: Yesod.Static exposed-modules: Yesod.Static
ghc-options: -Wall ghc-options: -Wall