th-orphans 0.9.0 → 0.9.1
raw patch · 4 files changed
+104/−86 lines, 4 filesdep +hspecdep +th-orphansdep ~basedep ~template-haskell
Dependencies added: hspec, th-orphans
Dependency ranges changed: base, template-haskell
Files
- src/Language/Haskell/TH/Instances.hs +62/−5
- src/Language/Haskell/TH/Instances/Internal.hs +0/−69
- test/Spec.hs +21/−0
- th-orphans.cabal +21/−12
src/Language/Haskell/TH/Instances.hs view
@@ -15,11 +15,14 @@ -- Provides 'Ord' and 'Lift' instances for the datatypes in -- "Language.Haskell.TH". Also provides 'Show' and 'Eq' for 'Loc', as -- well as 'Ppr' for 'Loc' and 'Lit'.+--+-- Note that the 'Ord' instances are not guaranteed to produce+-- consistent results across template-haskell / GHC versions, as they+-- have different data types, with different constructor orders. module Language.Haskell.TH.Instances () where import GHC.Real (Ratio) import Language.Haskell.TH-import Language.Haskell.TH.Instances.Internal import Language.Haskell.TH.Lift (deriveLiftMany) import Language.Haskell.TH.ReifyMany import Language.Haskell.TH.Syntax@@ -53,12 +56,66 @@ lift w = [e| fromIntegral $(lift (fromIntegral w :: Int)) |] #endif +$(reifyManyWithoutInstances ''Lift [''Info, ''Loc] (const True) >>=+ deriveLiftMany)++-- Ideally, it'd be possible to use reifyManyWithoutInstances for+-- these Ord instances, but TH can't output deriving instances (and+-- even if this is added for later versions, we need to support many+-- ghc / th versions). We can't generate Ord instances from TH due to+-- some undiagnosed funkiness:+-- https://github.com/mgsloan/th-orphans/issues/14++-- GHC 7.10 comes with Ord instances for TH datatypes.+#if !MIN_VERSION_template_haskell(2,10,0)+deriving instance Ord Info+deriving instance Ord Fixity+deriving instance Ord Exp+deriving instance Ord Dec+deriving instance Ord Stmt+deriving instance Ord Type+deriving instance Ord Foreign+deriving instance Ord FunDep+deriving instance Ord Con+deriving instance Ord Body+deriving instance Ord Clause+deriving instance Ord Strict+deriving instance Ord Safety+deriving instance Ord Callconv+deriving instance Ord Guard+deriving instance Ord Range+deriving instance Ord Match+deriving instance Ord Pat+deriving instance Ord Lit++#if MIN_VERSION_template_haskell(2,4,0)+deriving instance Ord FamFlavour+deriving instance Ord Pragma+deriving instance Ord Pred+deriving instance Ord TyVarBndr+#endif++#if MIN_VERSION_template_haskell(2,4,0) && !(MIN_VERSION_template_haskell(2,8,0))+deriving instance Ord InlineSpec+deriving instance Ord Kind+#endif+ #if MIN_VERSION_template_haskell(2,5,0) && !(MIN_VERSION_template_haskell(2,7,0)) deriving instance Eq ClassInstance+deriving instance Ord ClassInstance #endif -$(reifyManyWithoutInstances ''Ord [''Info] (`notElem` [''Ratio]) >>=- mapM deriveOrd)+#if MIN_VERSION_template_haskell(2,8,0)+deriving instance Ord Inline+deriving instance Ord Phases+deriving instance Ord RuleBndr+deriving instance Ord RuleMatch+deriving instance Ord TyLit+#endif -$(reifyManyWithoutInstances ''Lift [''Info, ''Loc] (const True) >>=- deriveLiftMany)+#if MIN_VERSION_template_haskell(2,9,0)+deriving instance Ord AnnTarget+deriving instance Ord Role+deriving instance Ord TySynEqn+#endif+#endif
− src/Language/Haskell/TH/Instances/Internal.hs
@@ -1,69 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module Language.Haskell.TH.Instances.Internal where--import Language.Haskell.TH---- Overall structure taken from--- https://hackage.haskell.org/package/derive-2.5.18/docs/src/Data-Derive-Ord.html--deriveOrd :: Name -> Q Dec-deriveOrd n = do- TyConI (DataD _ _ _ cons _) <- reify n- na <- newName "a"- nb <- newName "b"- ncheck <- newName "check"- nthen <- newName "_then"- ntag <- newName "_tag"- nx <- newName "x"- ny <- newName "y"- checkClauses <- flip mapM cons $ \con -> do- (pat1, names1) <- conToPat con- (pat2, names2) <- conToPat con- return $ Clause [pat1, pat2]- (NormalB $- foldr (\(n1, n2) ->- AppE (AppE (VarE nthen)- (AppE (AppE (VarE 'compare)- (VarE n1))- (VarE n2))))- (ConE 'EQ)- (zip names1 names2))- []- let lastCheckClause =- if length cons <= 1- then []- else [Clause [VarP nx, VarP ny]- (NormalB (AppE (AppE (VarE 'compare) (VarE nx)) (VarE ny)))- []]- tagClauses <- flip mapM (zip [0..] cons) $ \(ix, con) -> do- (pat, _) <- conToPat con- return $ Clause [pat]- (NormalB (SigE (LitE (IntegerL ix))- (ConT ''Int)))- []- return $ InstanceD []- (AppT (ConT ''Ord) (ConT n))- [FunD 'compare [Clause- [VarP na, VarP nb]- (NormalB (AppE (AppE (VarE ncheck)- (VarE na))- (VarE nb)))- [ FunD ncheck (checkClauses ++ lastCheckClause)- , FunD nthen- [ Clause [ConP 'EQ [], VarP nx] (NormalB (VarE nx)) []- , Clause [VarP nx, WildP] (NormalB (VarE nx)) []- ]- , FunD ntag tagClauses- ]]]--conToPat :: Con -> Q (Pat, [Name])-conToPat (RecC n fs) = conToPat (NormalC n (map (\(_, s, t) -> (s, t)) fs))-conToPat (ForallC _ _ con) = conToPat con-conToPat (NormalC n tys) = do- names <- mapM (\_ -> newName "_x") tys- return (ConP n (map VarP names), names)-conToPat (InfixC _ n _) = do- ln <- newName "_l"- rn <- newName "_r"- return (InfixP (VarP ln) n (VarP rn), [ln, rn])
+ test/Spec.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell #-}++import Language.Haskell.TH+import Language.Haskell.TH.Instances+import System.Timeout+import Test.Hspec++main :: IO ()+main = hspec $ do+ -- See https://github.com/mgsloan/th-orphans/issues/13+ it "Doesn't infinite loop when comparing types" $ do+ -- This can either yield LT or GT because different TH+ -- versions define the constructors in different orders.+ result <- timeout (1000 * 100) $+ compare (AppT (ConT ''Maybe) (ConT ''Int)) (ConT ''Char)+ `shouldSatisfy` (/= EQ)+ result `shouldBe` Just ()+ -- See https://github.com/mgsloan/th-orphans/issues/14+ it "Compares types correctly" $+ compare (AppT (ConT ''Maybe) (ConT ''Int)) (AppT (ConT ''Maybe) (ConT ''Char))+ `shouldBe` GT
th-orphans.cabal view
@@ -1,6 +1,6 @@ name: th-orphans-version: 0.9.0-cabal-version: >= 1.6+version: 0.9.1+cabal-version: >= 1.10 build-type: Simple license: BSD3 license-file: LICENSE@@ -10,8 +10,7 @@ maintainer: Michael Sloan <mgsloan at gmail> bug-reports: https://github.com/mgsloan/th-orphans/issues stability: experimental-tested-with: GHC == 6.12.3, GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2,- GHC == 7.6.1, GHC == 7.8+tested-with: GHC == 7.4.2, GHC == 7.6.1, GHC == 7.8 synopsis: Orphan instances for TH datatypes description: Orphan instances for TH datatypes. In particular, instances for Ord and Lift, as well as a few missing Show / Eq. These@@ -19,15 +18,25 @@ the version number started. library- build-depends: base >= 4.2 && < 5,- template-haskell,- th-lift >= 0.5,- th-reify-many >= 0.1 && < 0.2+ build-depends: base >= 4.2 && < 5,+ template-haskell,+ th-lift >= 0.5,+ th-reify-many >= 0.1 && < 0.2+ hs-source-dirs: src+ ghc-options: -Wall+ exposed-modules: Language.Haskell.TH.Instances+ default-language: Haskell2010 - hs-source-dirs: src- ghc-options: -Wall- exposed-modules: Language.Haskell.TH.Instances- other-modules: Language.Haskell.TH.Instances.Internal++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base,+ th-orphans,+ hspec,+ template-haskell+ default-language: Haskell2010 source-repository head type: git