Some fixes noticed on working with yesodweb

This commit is contained in:
Michael Snoyman 2012-01-08 11:05:05 +02:00
parent b586c41589
commit dfbdaf0b4c
5 changed files with 32 additions and 8 deletions

View File

@ -89,8 +89,8 @@ mkYesodDataGeneral name clazzes isSub res = do
let (name':rest) = words name let (name':rest) = words name
(x, _) <- mkYesodGeneral name' rest clazzes isSub res (x, _) <- mkYesodGeneral name' rest clazzes isSub res
let rname = mkName $ "resources" ++ name let rname = mkName $ "resources" ++ name
eres <- [|fmap parseType $(lift res)|] eres <- lift res
let y = [ SigD rname $ ListT `AppT` ConT ''Resource let y = [ SigD rname $ ListT `AppT` (ConT ''Resource `AppT` ConT ''String)
, FunD rname [Clause [] (NormalB eres) []] , FunD rname [Clause [] (NormalB eres) []]
] ]
return $ x ++ y return $ x ++ y

View File

@ -1,6 +1,7 @@
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module YesodCoreTest.Media (mediaTest, Widget) where module YesodCoreTest.Media (mediaTest, Widget) where
import Test.Hspec import Test.Hspec
@ -9,12 +10,9 @@ import Yesod.Core hiding (Request)
import Network.Wai import Network.Wai
import Network.Wai.Test import Network.Wai.Test
import Text.Lucius import Text.Lucius
import YesodCoreTest.MediaData
data Y = Y mkYesodDispatch "Y" resourcesY
mkYesod "Y" [parseRoutes|
/ RootR GET
/static StaticR GET
|]
instance Yesod Y where instance Yesod Y where
approot _ = "" approot _ = ""

View File

@ -0,0 +1,12 @@
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module YesodCoreTest.MediaData where
import Yesod.Core
data Y = Y
mkYesodData "Y" [parseRoutes|
/ RootR GET
/static StaticR GET
|]

View File

@ -18,6 +18,7 @@ extra-source-files:
test/en.msg test/en.msg
test/YesodCoreTest/NoOverloadedStrings.hs test/YesodCoreTest/NoOverloadedStrings.hs
test/YesodCoreTest/Media.hs test/YesodCoreTest/Media.hs
test/YesodCoreTest/MediaData.hs
test/YesodCoreTest/Exceptions.hs test/YesodCoreTest/Exceptions.hs
test/YesodCoreTest/Widget.hs test/YesodCoreTest/Widget.hs
test/YesodCoreTest/CleanPath.hs test/YesodCoreTest/CleanPath.hs

View File

@ -40,6 +40,7 @@ module Yesod.Static
, staticFilesList , staticFilesList
, publicFiles , publicFiles
-- * Hashing -- * Hashing
, base64md5
#ifdef TEST #ifdef TEST
, getFileListPieces , getFileListPieces
#endif #endif
@ -57,11 +58,12 @@ import Data.List (intercalate)
import Language.Haskell.TH import Language.Haskell.TH
import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax
import Crypto.Conduit (hashFile) import Crypto.Conduit (hashFile, sinkHash)
import Crypto.Hash.MD5 (MD5) import Crypto.Hash.MD5 (MD5)
import qualified Data.ByteString.Base64 import qualified Data.ByteString.Base64
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import qualified Data.Serialize import qualified Data.Serialize
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Data.Monoid (mempty) import Data.Monoid (mempty)
@ -74,6 +76,9 @@ import qualified Data.ByteString as S
import Network.HTTP.Types (status301) import Network.HTTP.Types (status301)
import System.PosixCompat.Files (getFileStatus, modificationTime) import System.PosixCompat.Files (getFileStatus, modificationTime)
import System.Posix.Types (EpochTime) import System.Posix.Types (EpochTime)
import Data.Conduit (($$), runResourceT)
import Data.Conduit.List (sourceList)
import Control.Monad.ST (runST)
import Network.Wai.Application.Static import Network.Wai.Application.Static
( StaticSettings (..) ( StaticSettings (..)
@ -315,6 +320,14 @@ base64md5File :: Prelude.FilePath -> IO String
base64md5File = fmap (base64 . encode) . hashFile base64md5File = fmap (base64 . encode) . hashFile
where encode d = Data.Serialize.encode (d :: MD5) where encode d = Data.Serialize.encode (d :: MD5)
base64md5 :: L.ByteString -> String
base64md5 lbs =
base64 $ encode
$ runST $ runResourceT
$ sourceList (L.toChunks lbs) $$ sinkHash
where
encode d = Data.Serialize.encode (d :: MD5)
base64 :: S.ByteString -> String base64 :: S.ByteString -> String
base64 = map tr base64 = map tr
. take 8 . take 8