Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
H
head.hackage
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Requirements
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Test cases
Artifacts
Deploy
Releases
Package Registry
Container Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Code review analytics
Issue analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Ellie Hermaszewska
head.hackage
Commits
26cfeb06
Commit
26cfeb06
authored
4 years ago
by
Hannes Siebenhandl
Browse files
Options
Downloads
Patches
Plain Diff
Add patches for ghcide dependencies
parent
508510d7
No related branches found
Branches containing commit
No related tags found
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
patches/dependent-sum-template-0.1.0.3.patch
+122
-0
122 additions, 0 deletions
patches/dependent-sum-template-0.1.0.3.patch
patches/th-extras-0.0.0.4.patch
+76
-0
76 additions, 0 deletions
patches/th-extras-0.0.0.4.patch
with
198 additions
and
0 deletions
patches/dependent-sum-template-0.1.0.3.patch
0 → 100644
+
122
−
0
View file @
26cfeb06
diff --git a/dependent-sum-template.cabal b/dependent-sum-template.cabal
index 1d2d17f..4b7f1c7 100644
--- a/dependent-sum-template.cabal
+++ b/dependent-sum-template.cabal
@@ -18,7 +18,8 @@
tested-with: GHC == 8.0.2,
GHC == 8.2.2,
GHC == 8.4.4,
GHC == 8.6.5,
- GHC == 8.8.3
+ GHC == 8.8.3,
+ GHC == 9.0.1
extra-source-files: ChangeLog.md
@@ -36,7 +37,8 @@
Library
build-depends: base >= 3 && <5,
dependent-sum >= 0.4.1 && < 0.8,
template-haskell,
- th-extras >= 0.0.0.2
+ th-extras >= 0.0.0.2,
+ th-abstraction
test-suite test
if impl(ghc < 8.0)
diff --git a/src/Data/Dependent/Sum/TH/Internal.hs b/src/Data/Dependent/Sum/TH/Internal.hs
index 0bf5afd..01e78c1 100644
--- a/src/Data/Dependent/Sum/TH/Internal.hs
+++ b/src/Data/Dependent/Sum/TH/Internal.hs
@@ -10,6 +10,7 @@
module Data.Dependent.Sum.TH.Internal where
import Control.Monad
import Language.Haskell.TH
import Language.Haskell.TH.Extras
+import Language.Haskell.TH.Datatype.TyVarBndr
classHeadToParams :: Type -> (Name, [Type])
classHeadToParams t = (h, reverse reversedParams)
@@ -24,8 +25,11 @@
classHeadToParams t = (h, reverse reversedParams)
-- Invoke the deriver for the given class instance. We assume that the type
-- we're deriving for is always the first typeclass parameter, if there are
-- multiple.
-deriveForDec :: Name -> (Q Type -> Q Type) -> ([TyVarBndr] -> [Con] -> Q Dec) -> Dec -> Q [Dec]
-deriveForDec className _ f (InstanceD overlaps cxt classHead decs) = do
+deriveForDec :: Name -> (Q Type -> Q Type) -> ([TyVarBndrSpec] -> [Con] -> Q Dec) -> Dec -> Q [Dec]
+deriveForDec className makeClassHead f dec = deriveForDec' className makeClassHead (f . changeTVFlags specifiedSpec) dec
+
+deriveForDec' :: Name -> (Q Type -> Q Type) -> ([TyVarBndrUnit] -> [Con] -> Q Dec) -> Dec -> Q [Dec]
+deriveForDec' className _ f (InstanceD overlaps cxt classHead decs) = do
let (givenClassName, firstParam : _) = classHeadToParams classHead
when (givenClassName /= className) $
fail $ "while deriving " ++ show className ++ ": wrong class name in prototype declaration: " ++ show givenClassName
@@ -36,20 +40,20 @@
deriveForDec className _ f (InstanceD overlaps cxt classHead decs) = do
dec <- f bndrs cons
return [InstanceD overlaps cxt classHead [dec]]
_ -> fail $ "while deriving " ++ show className ++ ": the name of an algebraic data type constructor is required"
-deriveForDec className makeClassHead f (DataD dataCxt name bndrs _ cons _) = return <$> inst
+deriveForDec' className makeClassHead f (DataD dataCxt name bndrs _ cons _) = return <$> inst
where
inst = instanceD (cxt (map return dataCxt)) (makeClassHead $ conT name) [dec]
dec = f bndrs cons
#if __GLASGOW_HASKELL__ >= 808
-deriveForDec className makeClassHead f (DataInstD dataCxt tvBndrs ty _ cons _) = return <$> inst
+deriveForDec' className makeClassHead f (DataInstD dataCxt tvBndrs ty _ cons _) = return <$> inst
#else
-deriveForDec className makeClassHead f (DataInstD dataCxt name tyArgs _ cons _) = return <$> inst
+deriveForDec' className makeClassHead f (DataInstD dataCxt name tyArgs _ cons _) = return <$> inst
#endif
where
inst = instanceD (cxt (map return dataCxt)) clhead [dec]
#if __GLASGOW_HASKELL__ >= 808
clhead = makeClassHead $ return $ initTy ty
- bndrs = [PlainTV v | PlainTV v <- maybe [] id tvBndrs]
+ bndrs = [tvb | tvb@PlainTV{} <- maybe [] id tvBndrs]
initTy (AppT ty _) = ty
#else
clhead = makeClassHead $ foldl1 appT (map return $ (ConT name : init tyArgs))
diff --git a/src/Data/GADT/Show/TH.hs b/src/Data/GADT/Show/TH.hs
index ca15c0b..b02fafe 100644
--- a/src/Data/GADT/Show/TH.hs
+++ b/src/Data/GADT/Show/TH.hs
@@ -10,7 +10,7 @@
import Data.Dependent.Sum.TH.Internal
import Data.Functor.Identity
import Data.GADT.Show
import Data.Traversable (for)
-import Data.List
+import Data.List (intersperse)
import Language.Haskell.TH
import Language.Haskell.TH.Extras
diff --git a/test/test.hs b/test/test.hs
index 499554c..39379fc 100644
--- a/test/test.hs
+++ b/test/test.hs
@@ -96,23 +96,22 @@
data Qux a where
deriveGEq ''Foo
deriveGEq ''Bar
-deriveGEq ''Baz
deriveGEq ''Qux
+deriveGEq ''Baz
deriveGCompare ''Foo
deriveGCompare ''Bar
-deriveGCompare ''Baz
deriveGCompare ''Qux
+deriveGCompare ''Baz
+deriveGShow ''Foo
instance Show (Foo a) where showsPrec = gshowsPrec
+deriveGShow ''Bar
instance Show (Bar a) where showsPrec = gshowsPrec
-instance Show (Baz a) where showsPrec = gshowsPrec
+deriveGShow ''Qux
instance Show (Qux a) where showsPrec = gshowsPrec
-
-deriveGShow ''Foo
-deriveGShow ''Bar
deriveGShow ''Baz
-deriveGShow ''Qux
+instance Show (Baz a) where showsPrec = gshowsPrec
data Squudge a where
E :: Ord a => Foo a -> Squudge a
This diff is collapsed.
Click to expand it.
patches/th-extras-0.0.0.4.patch
0 → 100644
+
76
−
0
View file @
26cfeb06
diff --git a/src/Language/Haskell/TH/Extras.hs b/src/Language/Haskell/TH/Extras.hs
index 9da19e3..2f50b0a 100644
--- a/src/Language/Haskell/TH/Extras.hs
+++ b/src/Language/Haskell/TH/Extras.hs
@@ -6,6 +6,7 @@
import Data.Generics
import Data.Maybe
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Datatype.TyVarBndr
intIs64 :: Bool
intIs64 = toInteger (maxBound :: Int) > 2^32
@@ -39,23 +40,21 @@
argTypesOfCon (GadtC _ args _) = map snd args
argTypesOfCon (RecGadtC _ args _) = [t | (_,_,t) <- args]
#endif
-nameOfBinder :: TyVarBndr -> Name
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 700
-nameOfBinder (PlainTV n) = n
-nameOfBinder (KindedTV n _) = n
-#else
-nameOfBinder = id
-type TyVarBndr = Name
-#endif
+nameOfBinder :: TyVarBndr_ a -> Name
+nameOfBinder = tvName
-varsBoundInCon :: Con -> [TyVarBndr]
+varsBoundInCon :: Con -> [TyVarBndrSpec]
varsBoundInCon (ForallC bndrs _ con) = bndrs ++ varsBoundInCon con
varsBoundInCon _ = []
namesBoundInPat :: Pat -> [Name]
namesBoundInPat (VarP name) = [name]
namesBoundInPat (TupP pats) = pats >>= namesBoundInPat
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 902
+namesBoundInPat (ConP _ _ pats) = pats >>= namesBoundInPat
+#else
namesBoundInPat (ConP _ pats) = pats >>= namesBoundInPat
+#endif
namesBoundInPat (InfixP p1 _ p2) = namesBoundInPat p1 ++ namesBoundInPat p2
namesBoundInPat (TildeP pat) = namesBoundInPat pat
namesBoundInPat (AsP name pat) = name : namesBoundInPat pat
@@ -141,7 +140,7 @@
headOfType (UnboxedTupleT n) = unboxedTupleTypeName n
occursInType :: Name -> Type -> Bool
occursInType var ty = case ty of
ForallT bndrs _ ty
- | any (var ==) (map nameOfBinder bndrs)
+ | any (var ==) (map tvName bndrs)
-> False
| otherwise
-> occursInType var ty
diff --git a/th-extras.cabal b/th-extras.cabal
index dcc4996..5eda8ab 100644
--- a/th-extras.cabal
+++ b/th-extras.cabal
@@ -2,7 +2,7 @@
name: th-extras
version: 0.0.0.4
stability: experimental
-cabal-version: >= 1.6
+cabal-version: >= 1.8
build-type: Simple
author: James Cook <mokus@deepbondi.net>
@@ -33,7 +33,8 @@
Library
hs-source-dirs: src
exposed-modules: Language.Haskell.TH.Extras
build-depends: base >= 3 && < 5,
- template-haskell
-
+ template-haskell < 2.18,
+ th-abstraction >= 0.4 && < 0.5
+
if flag(base4)
build-depends: base >= 4, syb
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment