Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

[WIP] update to haskell-src-exts-1.23 #37

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

[WIP] update to haskell-src-exts-1.23 #37

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
2 changes: 1 addition & 1 deletion derive.cabal
View file
Open in desktop
Expand Up @@ -37,7 +37,7 @@ library
base == 4.*,
filepath, syb, template-haskell, containers, pretty,
directory, process, bytestring,
haskell-src-exts == 1.20.*,
haskell-src-exts == 1.23.*,
transformers >= 0.2,
uniplate >= 1.5 && < 1.7

Expand Down
4 changes: 2 additions & 2 deletions src/Data/Derive/Arbitrary.hs
View file
Open in desktop
Expand Up @@ -48,7 +48,7 @@ makeArbitrary = derivationCustomDSL "Arbitrary" custom $
[App "()" (List []),Int 0,ShowInt (Int 0)])]),App "TyCon" (List [
App "()" (List []),App "UnQual" (List [App "()" (List []),App
"Ident" (List [App "()" (List []),String "Int"])])])]),App
"InfixApp" (List [App "()" (List []),App "App" (List [App "()" (
"TypeApp" (List [App "()" (List []),App "App" (List [App "()" (
List []),App "Var" (List [App "()" (List []),App "UnQual" (List [
App "()" (List []),App "Ident" (List [App "()" (List []),String
"length"])])]),App "List" (List [App "()" (List []),MapCtor (App
Expand Down Expand Up @@ -100,7 +100,7 @@ custom = customContext context
context :: FullDataDecl -> Context () -> Context ()
context (_,d) _ = CxTuple () $ nub $ concatMap (f True . snd) $ concatMap ctorDeclFields $ dataDeclCtors d
where
f b (TyVar _ x) = [ClassA () (qname $ b ? "Arbitrary" $ "CoArbitrary") [TyVar () x]]
f b (TyVar _ x) = [TypeA () $ TyVar () x]
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why has qname $ b ? "Arbitrary" $ "CoArbitrary" gone?

f b (TyFun _ x y) = f (not b) x ++ f b y
f b x = concatMap (f b) (children x)

2 changes: 1 addition & 1 deletion src/Data/Derive/ArbitraryOld.hs
View file
Open in desktop
Expand Up @@ -41,7 +41,7 @@ dslArbitraryOld =
[App "()" (List []),String "choose"])])]),App "Tuple" (List [App
"()" (List []),App "Boxed" (List []),List [App "Lit" (List [App
"()" (List []),App "Int" (List [App "()" (List []),Int 0,ShowInt (
Int 0)])]),App "InfixApp" (List [App "()" (List []),App "App" (
Int 0)])]),App "TypeApp" (List [App "()" (List []),App "App" (
List [App "()" (List []),App "Var" (List [App "()" (List []),App
"UnQual" (List [App "()" (List []),App "Ident" (List [App "()" (
List []),String "length"])])]),App "List" (List [App "()" (List []
Expand Down
4 changes: 2 additions & 2 deletions src/Data/Derive/Binary.hs
View file
Open in desktop
Expand Up @@ -86,7 +86,7 @@ dslBinary =
[App "PatBind" (List [App "()" (List []),App "PVar" (List [App
"()" (List []),App "Ident" (List [App "()" (List []),String
"useTag"])]),App "UnGuardedRhs" (List [App "()" (List []),App
"InfixApp" (List [App "()" (List []),App "App" (List [App "()" (
"TypeApp" (List [App "()" (List []),App "App" (List [App "()" (
List []),App "Var" (List [App "()" (List []),App "UnQual" (List [
App "()" (List []),App "Ident" (List [App "()" (List []),String
"length"])])]),App "List" (List [App "()" (List []),MapCtor (App
Expand Down Expand Up @@ -154,7 +154,7 @@ dslBinary =
List [App "()" (List []),List [App "PatBind" (List [App "()" (List
[]),App "PVar" (List [App "()" (List []),App "Ident" (List [App
"()" (List []),String "useTag"])]),App "UnGuardedRhs" (List [App
"()" (List []),App "InfixApp" (List [App "()" (List []),App "App"
"()" (List []),App "TypeApp" (List [App "()" (List []),App "App"
(List [App "()" (List []),App "Var" (List [App "()" (List []),App
"UnQual" (List [App "()" (List []),App "Ident" (List [App "()" (
List []),String "length"])])]),App "List" (List [App "()" (List []
Expand Down
4 changes: 2 additions & 2 deletions src/Data/Derive/BinaryDefer.hs
View file
Open in desktop
Expand Up @@ -54,7 +54,7 @@ dslBinaryDefer =
List [App "()" (List []),App "UnitCon" (List [App "()" (List [])])
])]),App "Var" (List [App "()" (List []),App "UnQual" (List [App
"()" (List []),App "Ident" (List [App "()" (List []),Concat (List
[String "x",ShowInt FieldIndex])])])])]))])]),App "InfixApp" (List
[String "x",ShowInt FieldIndex])])])])]))])]),App "TypeApp" (List
[App "()" (List []),App "App" (List [App "()" (List []),App "Var"
(List [App "()" (List []),App "UnQual" (List [App "()" (List []),
App "Ident" (List [App "()" (List []),String "unit"])])]),App
Expand All @@ -68,7 +68,7 @@ dslBinaryDefer =
App "Symbol" (List [App "()" (List []),String "<<!"])])]),App
"Var" (List [App "()" (List []),App "UnQual" (List [App "()" (List
[]),App "Ident" (List [App "()" (List []),String "o"])])])]),Fold
(App "InfixApp" (List [App "()" (List []),Tail,App "QVarOp" (List
(App "TypeApp" (List [App "()" (List []),Tail,App "QVarOp" (List
[App "()" (List []),App "UnQual" (List [App "()" (List []),App
"Symbol" (List [App "()" (List []),String "<<"])])]),Head])) (
Concat (List [Reverse (MapField (App "Var" (List [App "()" (List [
Expand Down
2 changes: 1 addition & 1 deletion src/Data/Derive/DSL/Apply.hs
View file
Open in desktop
Expand Up @@ -36,7 +36,7 @@ applyEnv dsl env@(Env input ctor field fold) = f dsl
,f body]
where
context = Just $ CxTuple ()
[ClassA () (UnQual () $ Ident () c) [TyVar () $ Ident () v]
[TypeA () $ TyVar () $ Ident () v
| let seen = [x | TyVar () (Ident () x) <- universeBi $ concatMap ctorDeclFields $ dataCtors input]
, v <- dataDeclVarsStar input `intersect` seen
, c <- ctx]
Expand Down
4 changes: 2 additions & 2 deletions src/Data/Derive/DSL/DSL.hs
View file
Open in desktop
Expand Up @@ -56,8 +56,8 @@ dslEq = box $ Instance ["Eq"] "Eq" $ box $ _1 "InsDecl" $ _1 "FunBind" $ match `
where
match = MapCtor $ _5 "Match" (o $ Symbol "==") (List [vars "x",vars "y"]) (o (Nothing :: Maybe Type)) (_1 "UnGuardedRhs" bod) (o $ BDecls [])
vars x = _2 "PApp" (_1 "UnQual" $ _1 "Ident" CtorName) (MapField (_1 "PVar" $ _1 "Ident" $ append (String x) (ShowInt FieldIndex)))
bod = Fold (_3 "InfixApp" Head (o $ QVarOp $ UnQual $ Symbol "&&") Tail) $ MapField pair `append` o [Con $ UnQual $ Ident "True"]
pair = _3 "InfixApp" (var "x") (o $ QVarOp $ UnQual $ Symbol "==") (var "y")
bod = Fold (_3 "TypeApp" Head (o $ QVarOp $ UnQual $ Symbol "&&") Tail) $ MapField pair `append` o [Con $ UnQual $ Ident "True"]
pair = _3 "TypeApp" (var "x") (o $ QVarOp $ UnQual $ Symbol "==") (var "y")
var x = _1 "Var" $ _1 "UnQual" $ _1 "Ident" $ append (String x) (ShowInt FieldIndex)

dull = o [Match sl (Symbol "==") [PWildCard,PWildCard] Nothing (UnGuardedRhs $ Con $ UnQual $ Ident "False") (BDecls [])]
Expand Down
2 changes: 1 addition & 1 deletion src/Data/Derive/DSL/Derive.hs
View file
Open in desktop
Expand Up @@ -40,7 +40,7 @@ guess (OApp "InstDecl" [_,OApp "Nothing" [],rule,decls])
| OApp "CxTuple" [_,OList xs] <- x = concatMap unClass xs
unContext x = []

unClass (OApp "ClassA" [_,OApp "UnQual" [_,OApp "Ident" [_,OString x]],_]) = [x]
unClass (OApp "TypeA" [_,OApp "UnQual" [_,OApp "Ident" [_,OString x]],_]) = [x]
unClass _ = []

unInstHead (OApp "IHCon" [_, name]) = (name, [])
Expand Down
2 changes: 1 addition & 1 deletion src/Data/Derive/DSL/SYB.hs
View file
Open in desktop
Expand Up @@ -74,7 +74,7 @@ dinstance :: DSL -> Maybe (Decl ())
dinstance x = do
Instance _ name bod <- return x
bod <- syb bod
let ctx = ClassA () (UnQual () $ Ident () "Data") [TyVar () $ Ident () "d_type"]
let ctx = TypeA () $ TyVar () $ Ident () "d_type"
let rule = IRule () Nothing (Just (CxSingle () ctx))
(IHApp () (IHCon () (UnQual () $ Ident () name)) (TyVar () $ Ident () "d_type"))
return $ InstDecl () Nothing rule bod
Expand Down
2 changes: 1 addition & 1 deletion src/Data/Derive/DataAbstract.hs
View file
Open in desktop
Expand Up @@ -76,4 +76,4 @@ makeDataAbstract = derivationCustomDSL "DataAbstract" custom $
custom = customContext context

context :: FullDataDecl -> Context () -> Context ()
context d _ = CxTuple () [ClassA () (qname t) [tyVar x] | x <- dataDeclVars $ snd d, t <- ["Typeable","Data"]]
context d _ = CxTuple () [TypeA () $ tyVar x | x <- dataDeclVars $ snd d, t <- ["Typeable","Data"]]
12 changes: 6 additions & 6 deletions src/Data/Derive/EnumCyclic.hs
View file
Open in desktop
Expand Up @@ -44,12 +44,12 @@ dslEnumCyclic =
"()" (List []),App "Ident" (List [App "()" (List []),String
"toEnum"]),List [App "PVar" (List [App "()" (List []),App "Ident"
(List [App "()" (List []),String "n"])])],App "UnGuardedRhs" (List
[App "()" (List []),App "InfixApp" (List [App "()" (List []),App
[App "()" (List []),App "TypeApp" (List [App "()" (List []),App
"Var" (List [App "()" (List []),App "UnQual" (List [App "()" (List
[]),App "Ident" (List [App "()" (List []),String "error"])])]),App
"QVarOp" (List [App "()" (List []),App "UnQual" (List [App "()" (
List []),App "Symbol" (List [App "()" (List []),String "$"])])]),
Fold (App "InfixApp" (List [App "()" (List []),Head,App "QVarOp" (
Fold (App "TypeApp" (List [App "()" (List []),Head,App "QVarOp" (
List [App "()" (List []),App "UnQual" (List [App "()" (List []),
App "Symbol" (List [App "()" (List []),String "++"])])]),Tail])) (
List [App "Lit" (List [App "()" (List []),App "String" (List [App
Expand All @@ -76,7 +76,7 @@ dslEnumCyclic =
(List []),String "succ"]),List [App "PVar" (List [App "()" (List [
]),App "Ident" (List [App "()" (List []),String "a"])])],App
"UnGuardedRhs" (List [App "()" (List []),App "If" (List [App "()"
(List []),App "InfixApp" (List [App "()" (List []),App "Var" (List
(List []),App "TypeApp" (List [App "()" (List []),App "Var" (List
[App "()" (List []),App "UnQual" (List [App "()" (List []),App
"Ident" (List [App "()" (List []),String "b"])])]),App "QVarOp" (
List [App "()" (List []),App "UnQual" (List [App "()" (List []),
Expand All @@ -94,7 +94,7 @@ dslEnumCyclic =
List []),App "Var" (List [App "()" (List []),App "UnQual" (List [
App "()" (List []),App "Ident" (List [App "()" (List []),String
"toEnum"])])]),App "Paren" (List [App "()" (List []),App
"InfixApp" (List [App "()" (List []),App "Var" (List [App "()" (
"TypeApp" (List [App "()" (List []),App "Var" (List [App "()" (
List []),App "UnQual" (List [App "()" (List []),App "Ident" (List
[App "()" (List []),String "b"])])]),App "QVarOp" (List [App "()"
(List []),App "UnQual" (List [App "()" (List []),App "Symbol" (
Expand All @@ -114,7 +114,7 @@ dslEnumCyclic =
"()" (List []),App "Ident" (List [App "()" (List []),String "pred"
]),List [App "PVar" (List [App "()" (List []),App "Ident" (List [
App "()" (List []),String "a"])])],App "UnGuardedRhs" (List [App
"()" (List []),App "If" (List [App "()" (List []),App "InfixApp" (
"()" (List []),App "If" (List [App "()" (List []),App "TypeApp" (
List [App "()" (List []),App "Var" (List [App "()" (List []),App
"UnQual" (List [App "()" (List []),App "Ident" (List [App "()" (
List []),String "b"])])]),App "QVarOp" (List [App "()" (List []),
Expand All @@ -133,7 +133,7 @@ dslEnumCyclic =
List [App "()" (List []),App "Var" (List [App "()" (List []),App
"UnQual" (List [App "()" (List []),App "Ident" (List [App "()" (
List []),String "toEnum"])])]),App "Paren" (List [App "()" (List [
]),App "InfixApp" (List [App "()" (List []),App "Var" (List [App
]),App "TypeApp" (List [App "()" (List []),App "Var" (List [App
"()" (List []),App "UnQual" (List [App "()" (List []),App "Ident"
(List [App "()" (List []),String "b"])])]),App "QVarOp" (List [App
"()" (List []),App "UnQual" (List [App "()" (List []),App "Symbol"
Expand Down
2 changes: 1 addition & 1 deletion src/Data/Derive/Internal/Traversal.hs
View file
Open in desktop
Expand Up @@ -108,7 +108,7 @@ traversalInstance tt nameBase dat bodyM = -- [simplify $ InstDecl () Nothing []
instHead = foldr (flip (IHApp ())) (IHCon () nam) args
(body, required) = runWriter (sequence bodyM)
ctx = CxTuple ()
[ ClassA () (qname $ className p) (tyVar n : vars tyVar 's' (p - 1))
[ TypeA () (qname $ className p) (tyVar n : vars tyVar 's' (p - 1))
| RequiredInstance n p <- S.toList required
]
vrs = vars tyVar 't' (dataDeclArity dat)
Expand Down
2 changes: 1 addition & 1 deletion src/Data/Derive/Monoid.hs
View file
Open in desktop
Expand Up @@ -72,7 +72,7 @@ dslMonoid =
"PWildCard" (List [App "()" (List [])]),App "PWildCard" (List [App
"()" (List [])])],App "GuardedRhss" (List [App "()" (List []),List
[App "GuardedRhs" (List [App "()" (List []),List [App "Qualifier"
(List [App "()" (List []),App "InfixApp" (List [App "()" (List [])
(List [App "()" (List []),App "TypeApp" (List [App "()" (List [])
,App "App" (List [App "()" (List []),App "Var" (List [App "()" (
List []),App "UnQual" (List [App "()" (List []),App "Ident" (List
[App "()" (List []),String "length"])])]),App "List" (List [App
Expand Down
2 changes: 1 addition & 1 deletion src/Data/Derive/NFData.hs
View file
Open in desktop
Expand Up @@ -27,7 +27,7 @@ dslNFData =
[App "()" (List []),CtorName])]),MapField (App "PVar" (List [App
"()" (List []),App "Ident" (List [App "()" (List []),Concat (List
[String "x",ShowInt FieldIndex])])]))])])],App "UnGuardedRhs" (
List [App "()" (List []),Fold (App "InfixApp" (List [App "()" (
List [App "()" (List []),Fold (App "TypeApp" (List [App "()" (
List []),Head,App "QVarOp" (List [App "()" (List []),App "UnQual"
(List [App "()" (List []),App "Ident" (List [App "()" (List []),
String "seq"])])]),Tail])) (Concat (List [MapField (App "App" (
Expand Down
4 changes: 2 additions & 2 deletions src/Data/Derive/Serial.hs
View file
Open in desktop
Expand Up @@ -32,7 +32,7 @@ dslSerial =
"InsDecl" (List [App "()" (List []),App "PatBind" (List [App "()"
(List []),App "PVar" (List [App "()" (List []),App "Ident" (List [
App "()" (List []),String "series"])]),App "UnGuardedRhs" (List [
App "()" (List []),Fold (App "InfixApp" (List [App "()" (List []),
App "()" (List []),Fold (App "TypeApp" (List [App "()" (List []),
Tail,App "QVarOp" (List [App "()" (List []),App "UnQual" (List [
App "()" (List []),App "Symbol" (List [App "()" (List []),String
"\\/"])])]),Head])) (Reverse (MapCtor (App "App" (List [App "()" (
Expand Down Expand Up @@ -68,7 +68,7 @@ dslSerial =
(List [App "()" (List []),App "Generator" (List [App "()" (List []
),App "PVar" (List [App "()" (List []),App "Ident" (List [App "()"
(List []),Concat (List [String "t",ShowInt CtorIndex])])]),App
"InfixApp" (List [App "()" (List []),Application (List [App "Var"
"TypeApp" (List [App "()" (List []),Application (List [App "Var"
(List [App "()" (List []),App "UnQual" (List [App "()" (List []),
App "Ident" (List [App "()" (List []),Concat (List [String "alts",
ShowInt CtorArity])])])]),App "Var" (List [App "()" (List []),App
Expand Down
4 changes: 2 additions & 2 deletions src/Data/Derive/Serialize.hs
View file
Open in desktop
Expand Up @@ -86,7 +86,7 @@ dslSerialize =
"BDecls" (List [App "()" (List []),List [App "PatBind" (List [App
"()" (List []),App "PVar" (List [App "()" (List []),App "Ident" (
List [App "()" (List []),String "useTag"])]),App "UnGuardedRhs" (
List [App "()" (List []),App "InfixApp" (List [App "()" (List []),
List [App "()" (List []),App "TypeApp" (List [App "()" (List []),
App "App" (List [App "()" (List []),App "Var" (List [App "()" (
List []),App "UnQual" (List [App "()" (List []),App "Ident" (List
[App "()" (List []),String "length"])])]),App "List" (List [App
Expand Down Expand Up @@ -155,7 +155,7 @@ dslSerialize =
"()" (List []),List [App "PatBind" (List [App "()" (List []),App
"PVar" (List [App "()" (List []),App "Ident" (List [App "()" (List
[]),String "useTag"])]),App "UnGuardedRhs" (List [App "()" (List [
]),App "InfixApp" (List [App "()" (List []),App "App" (List [App
]),App "TypeApp" (List [App "()" (List []),App "App" (List [App
"()" (List []),App "Var" (List [App "()" (List []),App "UnQual" (
List [App "()" (List []),App "Ident" (List [App "()" (List []),
String "length"])])]),App "List" (List [App "()" (List []),MapCtor
Expand Down
14 changes: 7 additions & 7 deletions src/Data/Derive/UniplateTypeable.hs
View file
Open in desktop
Expand Up @@ -35,19 +35,19 @@ makeUniplateTypeable = derivationCustomDSL "UniplateTypeable" custom $
List [App "InstDecl" (List [App "()" (List []),App "Nothing" (List
[]),App "IRule" (List [App "()" (List []),App "Nothing" (List []),
App "Just" (List [App "CxTuple" (List [App "()" (List []),List [
App "ClassA" (List [App "()" (List []),App "UnQual" (List [App
App "TypeA" (List [App "()" (List []),App "UnQual" (List [App
"()" (List []),App "Ident" (List [App "()" (List []),String
"Typeable"])]),List [App "TyVar" (List [App "()" (List []),App
"Ident" (List [App "()" (List []),String "a"])])]]),App "ClassA" (
"Ident" (List [App "()" (List []),String "a"])])]]),App "TypeA" (
List [App "()" (List []),App "UnQual" (List [App "()" (List []),
App "Ident" (List [App "()" (List []),String "PlateAll"])]),List [
App "TyVar" (List [App "()" (List []),App "Ident" (List [App "()"
(List []),String "a"])]),App "TyVar" (List [App "()" (List []),App
"Ident" (List [App "()" (List []),String "to"])])]]),App "ClassA"
"Ident" (List [App "()" (List []),String "to"])])]]),App "TypeA"
(List [App "()" (List []),App "UnQual" (List [App "()" (List []),
App "Ident" (List [App "()" (List []),String "Uniplate"])]),List [
App "TyVar" (List [App "()" (List []),App "Ident" (List [App "()"
(List []),String "to"])])]]),App "ClassA" (List [App "()" (List []
(List []),String "to"])])]]),App "TypeA" (List [App "()" (List []
),App "UnQual" (List [App "()" (List []),App "Ident" (List [App
"()" (List []),String "Typeable"])]),List [App "TyVar" (List [App
"()" (List []),App "Ident" (List [App "()" (List []),String "to"])
Expand All @@ -69,7 +69,7 @@ makeUniplateTypeable = derivationCustomDSL "UniplateTypeable" custom $
[App "()" (List []),CtorName])]),MapField (App "PVar" (List [App
"()" (List []),App "Ident" (List [App "()" (List []),Concat (List
[String "x",ShowInt FieldIndex])])]))])])],App "UnGuardedRhs" (
List [App "()" (List []),Fold (App "InfixApp" (List [App "()" (
List [App "()" (List []),Fold (App "TypeApp" (List [App "()" (
List []),Tail,App "QVarOp" (List [App "()" (List []),App "UnQual"
(List [App "()" (List []),App "Symbol" (List [App "()" (List []),
String "|+"])])]),Head])) (Concat (List [Reverse (MapField (App
Expand All @@ -92,10 +92,10 @@ custom (_,d) [InstDecl () x2 (IRule () x3 _ ihead) x7] = [InstDecl () x2 (IRule
vars = dataDeclVars d
dd = (if null vars then id else TyParen ()) $ tyApps (tyCon $ dataDeclName d) (map tyVar vars)
x4 = Just $ CxTuple () $
concatMap f vars ++ [ClassA () (qname x) [tyVar "to"] | x <- ["Typeable","Uniplate"]]
concatMap f vars ++ [TypeA () $ tyVar "to" | x <- ["Typeable","Uniplate"]]
x6 = [dd, tyVar "to"]
iheadOut = foldr (flip (IHApp ())) (IHCon () x5) x6
f v = [ClassA () (qname "Typeable") [tyVar v], ClassA () (qname "PlateAll") [tyVar v, tyVar "to"]]
f v = [TypeA () $ tyVar v, TypeA () (qname "PlateAll") [tyVar v, tyVar "to"]]
collect acc (IHCon () qname) = (acc, qname)
collect acc (IHInfix () arg qname) = (arg:acc, qname)
collect acc (IHParen () ih) = collect acc ih
Expand Down
2 changes: 1 addition & 1 deletion src/Language/Haskell.hs
View file
Open in desktop
Expand Up @@ -283,7 +283,7 @@ dataDeclVars (DataDecl _ _ _ hd _ _) = map f $ snd $ fromDeclHead hd
dataDeclVarsStar :: DataDecl -> [String]
dataDeclVarsStar (DataDecl _ _ _ hd _ _) = mapMaybe f $ snd $ fromDeclHead hd
where f (UnkindedVar _ x) = Just $ prettyPrint x
f (KindedVar _ x (KindStar _)) = Just $ prettyPrint x
f (KindedVar _ x (TyStar _)) = Just $ prettyPrint x
f _ = Nothing

dataDeclArity :: DataDecl -> Int
Expand Down