Merge pull request #1213 from erikd/master

Fixes for ghc-8.0 and persistent 2.5
This commit is contained in:
Michael Snoyman 2016-04-20 13:18:44 +03:00
commit d44f8539ab
7 changed files with 75 additions and 23 deletions

View File

@ -27,7 +27,7 @@ library
, yesod-auth >= 1.4 && < 1.5
, text >= 0.7
, yesod-form >= 1.4 && < 1.5
, transformers >= 0.2.2 && < 0.5
, transformers >= 0.2.2 && < 0.6
, lifted-base >= 0.2 && < 0.3
exposed-modules: Yesod.Auth.OAuth
ghc-options: -Wall

View File

@ -38,7 +38,7 @@ library
, yesod-form >= 1.4 && < 1.5
, transformers >= 0.2.2
, persistent >= 2.1 && < 2.6
, persistent-template >= 2.1 && < 2.2
, persistent-template >= 2.1 && < 2.6
, http-client
, http-conduit >= 2.1
, aeson >= 0.7

View File

@ -85,12 +85,36 @@ getPackageArgs buildDir argv2 = do
dflags0 <- GHC.getSessionDynFlags
(dflags1, _, _) <- GHC.parseDynamicFlags dflags0 argv3
let pkgFlags = map convertPkgFlag (GHC.packageFlags dflags1)
ignorePkgFlags =
#if __GLASGOW_HASKELL__ >= 800
map convertIgnorePkgFlag (GHC.ignorePackageFlags dflags1)
#else
[]
#endif
trustPkgFlags =
#if __GLASGOW_HASKELL__ >= 800
map convertTrustPkgFlag (GHC.trustFlags dflags1)
#else
[]
#endif
hideAll | gopt DF.Opt_HideAllPackages dflags1 = [ "-hide-all-packages"]
| otherwise = []
ownPkg = packageString (DF.thisPackage dflags1)
return (reverse (extra dflags1) ++ hideAll ++ pkgFlags ++ [ownPkg])
return (reverse (extra dflags1) ++ hideAll ++ trustPkgFlags ++ ignorePkgFlags ++ pkgFlags ++ [ownPkg])
where
#if __GLASGOW_HASKELL__ >= 710
#if __GLASGOW_HASKELL__ >= 800
convertIgnorePkgFlag (DF.IgnorePackage p) = "-ignore-package" ++ p
convertTrustPkgFlag (DF.TrustPackage p) = "-trust" ++ p
convertTrustPkgFlag (DF.DistrustPackage p) = "-distrust" ++ p
#else
convertPkgFlag (DF.IgnorePackage p) = "-ignore-package" ++ p
convertPkgFlag (DF.TrustPackage p) = "-trust" ++ p
convertPkgFlag (DF.DistrustPackage p) = "-distrust" ++ p
#endif
#if __GLASGOW_HASKELL__ >= 800
convertPkgFlag (DF.ExposePackage _ (DF.PackageArg p) _) = "-package" ++ p
convertPkgFlag (DF.ExposePackage _ (DF.UnitIdArg p) _) = "-package-id" ++ p
#elif __GLASGOW_HASKELL__ == 710
convertPkgFlag (DF.ExposePackage (DF.PackageArg p) _) = "-package" ++ p
convertPkgFlag (DF.ExposePackage (DF.PackageIdArg p) _) = "-package-id" ++ p
convertPkgFlag (DF.ExposePackage (DF.PackageKeyArg p) _) = "-package-key" ++ p
@ -99,10 +123,9 @@ getPackageArgs buildDir argv2 = do
convertPkgFlag (DF.ExposePackageId p) = "-package-id" ++ p
#endif
convertPkgFlag (DF.HidePackage p) = "-hide-package" ++ p
convertPkgFlag (DF.IgnorePackage p) = "-ignore-package" ++ p
convertPkgFlag (DF.TrustPackage p) = "-trust" ++ p
convertPkgFlag (DF.DistrustPackage p) ="-distrust" ++ p
#if __GLASGOW_HASKELL__ >= 710
#if __GLASGOW_HASKELL__ >= 800
packageString flags = "-package-id" ++ Module.unitIdString flags
#elif __GLASGOW_HASKELL__ == 710
packageString flags = "-package-key" ++ Module.packageKeyString flags
#else
packageString flags = "-package-id" ++ Module.packageIdString flags ++ "-inplace"
@ -162,7 +185,9 @@ buildPackage' argv2 ld ar = do
haskellish (f,Nothing) =
looksLikeModuleName f || isHaskellSrcFilename f || '.' `notElem` f
haskellish (_,Just phase) =
#if MIN_VERSION_ghc(7,8,3)
#if MIN_VERSION_ghc(8,0,0)
phase `notElem` [As True, As False, Cc, Cobjc, Cobjcxx, CmmCpp, Cmm, StopLn]
#elif MIN_VERSION_ghc(7,8,3)
phase `notElem` [As True, As False, Cc, Cobjc, Cobjcpp, CmmCpp, Cmm, StopLn]
#elif MIN_VERSION_ghc(7,4,0)
phase `notElem` [As, Cc, Cobjc, Cobjcpp, CmmCpp, Cmm, StopLn]

View File

@ -86,8 +86,13 @@ mkYesodGeneral namestr args isSub f resS = do
case info of
TyConI dec ->
case dec of
#if MIN_VERSION_template_haskell(2,11,0)
DataD _ _ vs _ _ _ -> length vs
NewtypeD _ _ vs _ _ _ -> length vs
#else
DataD _ _ vs _ _ -> length vs
NewtypeD _ _ vs _ _ -> length vs
#endif
_ -> 0
_ -> 0
_ -> return 0

View File

@ -8,6 +8,9 @@ module Yesod.Routes.TH.RenderRoute
) where
import Yesod.Routes.TH.Types
#if MIN_VERSION_template_haskell(2,11,0)
import Language.Haskell.TH (conT)
#endif
import Language.Haskell.TH.Syntax
import Data.Maybe (maybeToList)
import Control.Monad (replicateM)
@ -15,19 +18,20 @@ import Data.Text (pack)
import Web.PathPieces (PathPiece (..), PathMultiPiece (..))
import Yesod.Routes.Class
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
import Data.Monoid (mconcat)
#endif
-- | Generate the constructors of a route data type.
mkRouteCons :: [ResourceTree Type] -> ([Con], [Dec])
mkRouteCons =
mconcat . map mkRouteCon
mkRouteCons :: [ResourceTree Type] -> Q ([Con], [Dec])
mkRouteCons rttypes =
mconcat <$> mapM mkRouteCon rttypes
where
mkRouteCon (ResourceLeaf res) =
([con], [])
return ([con], [])
where
con = NormalC (mkName $ resourceName res)
$ map (\x -> (NotStrict, x))
$ map (\x -> (notStrict, x))
$ concat [singles, multi, sub]
singles = concatMap toSingle $ resourcePieces res
toSingle Static{} = []
@ -39,14 +43,19 @@ mkRouteCons =
case resourceDispatch res of
Subsite { subsiteType = typ } -> [ConT ''Route `AppT` typ]
_ -> []
mkRouteCon (ResourceParent name _check pieces children) =
([con], dec : decs)
mkRouteCon (ResourceParent name _check pieces children) = do
(cons, decs) <- mkRouteCons children
#if MIN_VERSION_template_haskell(2,11,0)
dec <- DataD [] (mkName name) [] Nothing cons <$> mapM conT [''Show, ''Read, ''Eq]
#else
let dec = DataD [] (mkName name) [] cons [''Show, ''Read, ''Eq]
#endif
return ([con], dec : decs)
where
(cons, decs) = mkRouteCons children
con = NormalC (mkName name)
$ map (\x -> (NotStrict, x))
$ map (\x -> (notStrict, x))
$ concat [singles, [ConT $ mkName name]]
dec = DataD [] (mkName name) [] cons [''Show, ''Read, ''Eq]
singles = concatMap toSingle pieces
toSingle Static{} = []
@ -143,10 +152,23 @@ mkRenderRouteInstance = mkRenderRouteInstance' []
mkRenderRouteInstance' :: Cxt -> Type -> [ResourceTree Type] -> Q [Dec]
mkRenderRouteInstance' cxt typ ress = do
cls <- mkRenderRouteClauses ress
let (cons, decs) = mkRouteCons ress
(cons, decs) <- mkRouteCons ress
#if MIN_VERSION_template_haskell(2,11,0)
did <- DataInstD [] ''Route [typ] Nothing cons <$> mapM conT clazzes
#else
let did = DataInstD [] ''Route [typ] cons clazzes
#endif
return $ InstanceD cxt (ConT ''RenderRoute `AppT` typ)
[ DataInstD [] ''Route [typ] cons clazzes
[ did
, FunD (mkName "renderRoute") cls
] : decs
where
clazzes = [''Show, ''Eq, ''Read]
#if MIN_VERSION_template_haskell(2,11,0)
notStrict :: Bang
notStrict = Bang NoSourceUnpackedness NoSourceStrictness
#else
notStrict :: Strict
notStrict = NotStrict
#endif

View File

@ -41,7 +41,7 @@ case500 :: IO ()
case500 = runner $ do
res <- request defaultRequest
assertStatus 500 res
assertBody "FOOBAR" res
assertBodyContains "FOOBAR" res
caseRedirect :: IO ()
caseRedirect = runner $ do

View File

@ -17,7 +17,7 @@ library
build-depends: base >= 4 && < 5
, yesod-core >= 1.4.0 && < 1.5
, persistent >= 2.1 && < 2.6
, persistent-template >= 2.1 && < 2.2
, persistent-template >= 2.1 && < 2.6
, transformers >= 0.2.2
, blaze-builder
, conduit