Some fixes noticed on working with yesodweb
This commit is contained in:
parent
b586c41589
commit
dfbdaf0b4c
@ -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
|
||||||
|
|||||||
@ -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 _ = ""
|
||||||
|
|||||||
12
yesod-core/test/YesodCoreTest/MediaData.hs
Normal file
12
yesod-core/test/YesodCoreTest/MediaData.hs
Normal 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
|
||||||
|
|]
|
||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user