web-routes-th 0.22.6.6 → 0.22.7
raw patch · 3 files changed
+28/−41 lines, 3 filesdep ~basedep ~hspecdep ~split
Dependency ranges changed: base, hspec, split, template-haskell, text, web-routes
Files
- Web/Routes/TH.hs +6/−20
- test/Test.hs +11/−10
- web-routes-th.cabal +11/−11
Web/Routes/TH.hs view
@@ -47,18 +47,13 @@ = do c <- parseInfo name case c of Tagged cons cx keys ->- do let context = [ mkCtx ''PathInfo [varT key] | key <- keys ] ++ map return cx- i <- instanceD (sequence context) (mkType ''PathInfo [mkType name (map varT keys)])+ do let context = pure $ [ AppT (ConT ''PathInfo) (VarT key) | key <- keys ] ++ cx+ i <- instanceD context (mkType ''PathInfo [mkType name (map varT keys)]) [ toPathSegmentsFn cons , fromPathSegmentsFn cons ] return [i] where-#if MIN_VERSION_template_haskell(2,4,0)- mkCtx = classP-#else- mkCtx = mkType-#endif toPathSegmentsFn :: [(Name, Int)] -> DecQ toPathSegmentsFn cons = do inp <- newName "inp"@@ -92,23 +87,18 @@ parseInfo name = do info <- reify name case info of-#if MIN_VERSION_template_haskell(2,11,0) TyConI (DataD cx _ keys _ cs _) -> return $ Tagged (map conInfo cs) cx $ map conv keys TyConI (NewtypeD cx _ keys _ con _)-> return $ Tagged [conInfo con] cx $ map conv keys-#else- TyConI (DataD cx _ keys cs _) -> return $ Tagged (map conInfo cs) cx $ map conv keys- TyConI (NewtypeD cx _ keys con _)-> return $ Tagged [conInfo con] cx $ map conv keys-#endif- _ -> error $ "derivePathInfo - invalid input: " ++ pprint info where conInfo (NormalC n args) = (n, length args) conInfo (RecC n args) = (n, length args) conInfo (InfixC _ n _) = (n, 2) conInfo (ForallC _ _ con) = conInfo con-#if MIN_VERSION_template_haskell(2,4,0)+#if MIN_VERSION_template_haskell(2,17,0)+ conv (PlainTV nm _) = nm+ conv (KindedTV nm _ _) = nm+#else conv (PlainTV nm) = nm conv (KindedTV nm _) = nm-#else- conv = id #endif -- | the standard formatter@@ -143,11 +133,7 @@ parseMethods con = do info <- reify con case info of-#if MIN_VERSION_template_haskell(2,11,0) (DataConI _ ty _) ->-#else- (DataConI _ ty _ _) ->-#endif do runIO $ print ty runIO $ print $ lastTerm ty return $ extractMethods (lastTerm ty)
test/Test.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings, TemplateHaskell #-}+{-# LANGUAGE ExtendedDefaultRules, FlexibleInstances, GeneralizedNewtypeDeriving, OverloadedStrings, TemplateHaskell, DatatypeContexts #-} module Main (main) where @@ -11,29 +11,30 @@ newtype ArticleId = ArticleId Int deriving (Eq, Show, Num, PathInfo, Arbitrary) -data Sitemap- = Home+-- the use of Show is and 'a' is to exercise the context generation of the 'derivePathInfo' code+data (Show a) => Sitemap a+ = Home a | Article ArticleId deriving (Eq, Show) derivePathInfo ''Sitemap -instance Arbitrary Sitemap where- arbitrary = oneof [return Home, fmap Article arbitrary]+instance Arbitrary (Sitemap Int) where+ arbitrary = oneof [fmap Home arbitrary, fmap Article arbitrary] -prop_PathInfo_isomorphism :: Sitemap -> Bool+prop_PathInfo_isomorphism :: Sitemap Int -> Bool prop_PathInfo_isomorphism = pathInfoInverse_prop case_toPathInfo :: Assertion case_toPathInfo =- do toPathInfo Home @?= "/home"- toPathInfo (Article 0) @?= "/article/0"+ do toPathInfo ((Home 1) :: Sitemap Int) @?= "/home/1"+ toPathInfo ((Article 0):: Sitemap Int) @?= "/article/0" case_fromPathInfo :: Assertion case_fromPathInfo =- do fromPathInfo "/home" @?= Right Home+ do fromPathInfo "/home/1" @?= ((Right (Home (1 :: Int))) :: Either String (Sitemap Int)) fromPathInfo "/article/0" @?= Right (Article 0)- case fromPathInfo "/" :: Either String Sitemap of+ case fromPathInfo "/" :: Either String (Sitemap Int) of Left _ -> return () url -> assertFailure $ "expected a Left, but got: " ++ show url
web-routes-th.cabal view
@@ -1,5 +1,5 @@ Name: web-routes-th-Version: 0.22.6.6+Version: 0.22.7 License: BSD3 License-File: LICENSE Author: jeremy@seereason.com@@ -12,7 +12,7 @@ Template Haskell. Cabal-Version: >= 1.10 Build-type: Simple-tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.2.2, GHC == 8.4.1, GHC == 8.6.3, GHC == 8.8.3, GHC == 8.10.1+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.1, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7, GHC==9.0.2, GHC==9.2.2 source-repository head type: git@@ -23,21 +23,21 @@ type : exitcode-stdio-1.0 main-is : Test.hs hs-source-dirs : test- build-depends : base == 4.*,- hspec >= 2.2 && < 2.8,+ build-depends : base >= 4.9 && < 5,+ hspec >= 2.2 && < 2.10, HUnit, QuickCheck,- web-routes,+ web-routes >= 0.27 && < 0.28, web-routes-th Library Default-Language: Haskell2010- Build-Depends: base >= 4 && < 5,- parsec >= 2 && < 4,- template-haskell < 2.17,- text,- split,- web-routes >= 0.26+ Build-Depends: base >= 4.9 && < 5,+ parsec >= 2 && < 4,+ template-haskell >= 2.11 && < 2.19,+ text >= 0.11 && < 2.1,+ split >= 0.2 && < 0.3,+ web-routes >= 0.26 && < 0.28 Exposed-Modules: Web.Routes.TH source-repository head