Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit 870e7c9

Browse files
alanzalanz
committed
Compiles for GHC 8.6.1 using cabal new-build
But not with stack
1 parent 380d8c7 commit 870e7c9

File tree

10 files changed

+140
-23
lines changed

10 files changed

+140
-23
lines changed

‎.circleci/config.yml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -143,7 +143,8 @@ jobs:
143143
cabal:
144144
working_directory: ~/build
145145
docker:
146-
- image: quay.io/haskell_works/ghc-8.4.3
146+
# - image: quay.io/haskell_works/ghc-8.4.3
147+
- image: quay.io/haskell_works/ghc-8.6.2
147148
steps:
148149
- checkout
149150
- run:

‎.gitmodules

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,4 +26,7 @@
2626

2727
[submodule "submodules/brittany"]
2828
path = submodules/brittany
29-
url = https://github.com/alanz/brittany.git
29+
url = https://github.com/lspitzner/brittany.git
30+
[submodule "submodules/apply-refact"]
31+
path = submodules/apply-refact
32+
url = https://github.com/alanz/apply-refact.git

‎cabal.project

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,13 @@ packages:
22
./
33
./hie-plugin-api/
44

5+
./submodules/apply-refact
56
./submodules/brittany
67
./submodules/HaRe
78
./submodules/ghc-mod/
89
./submodules/ghc-mod/core/
910
./submodules/cabal-helper/
11+
12+
allow-newer:ekg-core-0.1.1.4:base
13+
allow-newer:ekg-json-0.1.0.6:base
14+
allow-newer:ekg-wai-0.1.0.3:base

‎hie-plugin-api/Haskell/Ide/Engine/ArtifactMap.hs

Lines changed: 41 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,19 @@ genLocMap tm = names
6969
checker (GHC.L (GHC.RealSrcSpan r) x) = IM.singleton (rspToInt r) x
7070
checker _ = IM.empty
7171

72-
#if __GLASGOW_HASKELL__ > 710
72+
#if __GLASGOW_HASKELL__ >= 806
73+
fieldOcc :: GHC.FieldOcc GM.GhcRn -> LocMap
74+
fieldOcc (GHC.FieldOcc n (GHC.L (GHC.RealSrcSpan r) _)) = IM.singleton (rspToInt r) n
75+
fieldOcc _ = IM.empty
76+
77+
hsRecFieldN :: GHC.LHsExpr GM.GhcRn -> LocMap
78+
hsRecFieldN (GHC.L _ (GHC.HsRecFld _ (GHC.Unambiguous n (GHC.L (GHC.RealSrcSpan r) _)) )) = IM.singleton (rspToInt r) n
79+
hsRecFieldN _ = IM.empty
80+
81+
hsRecFieldT :: GHC.LHsExpr GM.GhcTc -> LocMap
82+
hsRecFieldT (GHC.L _ (GHC.HsRecFld _ (GHC.Ambiguous n (GHC.L (GHC.RealSrcSpan r) _)) )) = IM.singleton (rspToInt r) (Var.varName n)
83+
hsRecFieldT _ = IM.empty
84+
#elif __GLASGOW_HASKELL__ > 710
7385
fieldOcc :: GHC.FieldOcc GM.GhcRn -> LocMap
7486
fieldOcc (GHC.FieldOcc (GHC.L (GHC.RealSrcSpan r) _) n) = IM.singleton (rspToInt r) n
7587
fieldOcc _ = IM.empty
@@ -104,7 +116,11 @@ genImportMap tm = moduleMap
104116
goImp acc _ = acc
105117

106118
goExp :: ModuleMap -> GHC.LIE name -> ModuleMap
119+
#if __GLASGOW_HASKELL__ >= 806
120+
goExp acc (GHC.L (GHC.RealSrcSpan r) (GHC.IEModuleContents _ lmn)) =
121+
#else
107122
goExp acc (GHC.L (GHC.RealSrcSpan r) (GHC.IEModuleContents lmn)) =
123+
#endif
108124
IM.insert (rspToInt r) (GHC.unLoc lmn) acc
109125
goExp acc _ = acc
110126

@@ -115,22 +131,45 @@ genDefMap tm = mconcat $ map (go . GHC.unLoc) decls
115131
where
116132
go :: GHC.HsDecl GM.GhcPs -> DefMap
117133
-- Type signatures
134+
#if __GLASGOW_HASKELL__ >= 806
135+
go (GHC.SigD _ (GHC.TypeSig _ lns _)) =
136+
#else
118137
go (GHC.SigD (GHC.TypeSig lns _)) =
138+
#endif
119139
foldl IM.union mempty $ fmap go' lns
120-
where go' (GHC.L (GHC.RealSrcSpan r) n) = IM.singleton (rspToInt r) n
140+
where go' (GHC.L (GHC.RealSrcSpan r) n) = IM.singleton (rspToInt r) n
121141
go' _ = mempty
122142
-- Definitions
143+
#if __GLASGOW_HASKELL__ >= 806
144+
go (GHC.ValD _ (GHC.FunBind _ (GHC.L (GHC.RealSrcSpan r) n) GHC.MG { GHC.mg_alts = llms } _ _)) =
145+
#else
123146
go (GHC.ValD (GHC.FunBind (GHC.L (GHC.RealSrcSpan r) n) GHC.MG { GHC.mg_alts = llms } _ _ _)) =
147+
#endif
124148
IM.insert (rspToInt r) n wheres
125149
where
126150
wheres = mconcat $ fmap (gomatch . GHC.unLoc) (GHC.unLoc llms)
127151

128152
gomatch GHC.Match { GHC.m_grhss = GHC.GRHSs { GHC.grhssLocalBinds = lbs } } =
129153
golbs (GHC.unLoc lbs)
154+
#if __GLASGOW_HASKELL__ >= 806
155+
gomatch GHC.XMatch{} = error "GHC.XMatch"
156+
gomatch (GHC.Match _ _ _ (GHC.XGRHSs _)) = error "GHC.XMatch"
157+
#endif
130158

159+
#if __GLASGOW_HASKELL__ >= 806
160+
golbs (GHC.HsValBinds _ (GHC.ValBinds _ lhsbs lsigs)) =
161+
#elif __GLASGOW_HASKELL__ > 802
162+
golbs (GHC.HsValBinds (GHC.ValBinds _ lhsbs lsigs)) =
163+
#else
131164
golbs (GHC.HsValBinds (GHC.ValBindsIn lhsbs lsigs)) =
165+
#endif
166+
#if __GLASGOW_HASKELL__ >= 806
167+
foldl (\acc x -> IM.union acc (go $ GHC.ValD GHC.NoExt $ GHC.unLoc x)) mempty lhsbs
168+
`mappend` foldl IM.union mempty (fmap (go . GHC.SigD GHC.NoExt . GHC.unLoc) lsigs)
169+
#else
132170
foldl (\acc x -> IM.union acc (go $ GHC.ValD $ GHC.unLoc x)) mempty lhsbs
133171
`mappend` foldl IM.union mempty (fmap (go . GHC.SigD . GHC.unLoc) lsigs)
172+
#endif
134173
golbs _ = mempty
135174
go _ = mempty
136175
decls = GHC.hsmodDecls $ GHC.unLoc $ GHC.pm_parsed_source $ GHC.tm_parsed_module tm
@@ -168,6 +207,3 @@ toPos (l,c) = Position (l-1) (c-1)
168207

169208
-- ---------------------------------------------------------------------
170209
-- ---------------------------------------------------------------------
171-
172-
173-

‎hie-plugin-api/Haskell/Ide/Engine/Context.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -21,15 +21,15 @@ getContext :: Position -> ParsedModule -> Maybe Context
2121
getContext pos pm = everything join (Nothing `mkQ` go `extQ` goInline) decl
2222
where decl = hsmodDecls $ unLoc $ pm_parsed_source pm
2323
go :: LHsDecl GhcPs -> Maybe Context
24-
go (L (RealSrcSpan r) (SigD _))
24+
go (L (RealSrcSpan r) (SigD {}))
2525
| pos `isInsideRange` r = Just TypeContext
2626
| otherwise = Nothing
27-
go (L (GHC.RealSrcSpan r) (GHC.ValD _))
28-
| pos `isInsideRange` r = Just ValueContext
27+
go (L (GHC.RealSrcSpan r) (GHC.ValD {}))
28+
| pos `isInsideRange` r = Just ValueContext
2929
| otherwise = Nothing
3030
go _ = Nothing
3131
goInline :: GHC.LHsType GhcPs -> Maybe Context
32-
goInline (GHC.L (GHC.RealSrcSpan r) _)
32+
goInline (GHC.L (GHC.RealSrcSpan r) _)
3333
| pos `isInsideRange` r = Just TypeContext
3434
| otherwise = Nothing
3535
goInline _ = Nothing

‎src/Haskell/Ide/Engine/Plugin/Example2.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE CPP #-}
2-
{-# LANGUAGE DeriveAnyClass #-}
2+
{-# LANGUAGE DeriveAnyClass #-}
33
{-# LANGUAGE DeriveGeneric #-}
4+
{-# LANGUAGE DuplicateRecordFields #-}
45
{-# LANGUAGE OverloadedStrings #-}
56
module Haskell.Ide.Engine.Plugin.Example2 where
67

‎src/Haskell/Ide/Engine/Plugin/GhcMod.hs

Lines changed: 79 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE CPP #-}
12
{-# LANGUAGE DeriveGeneric #-}
23
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE OverloadedStrings #-}
@@ -609,38 +610,93 @@ symbolProvider uri = pluginGetFile "ghc-mod symbolProvider: " uri $
609610
decls = concatMap go $ hsmodDecls hsMod
610611

611612
go :: LHsDecl GM.GhcPs -> [Decl]
612-
go (L l (TyClD FamDecl { tcdFam = FamilyDecl { fdLName = n } })) = pure (Decl LSP.SkClass n [] l)
613-
go (L l (TyClD SynDecl { tcdLName = n })) = pure (Decl LSP.SkClass n [] l)
614-
go (L l (TyClD DataDecl { tcdLName = n, tcdDataDefn = HsDataDefn { dd_cons = cons } })) =
613+
#if __GLASGOW_HASKELL__ >= 806
614+
go (L l (TyClD _ d)) = goTyClD (L l d)
615+
#else
616+
go (L l (TyClD d)) = goTyClD (L l d)
617+
#endif
618+
619+
#if __GLASGOW_HASKELL__ >= 806
620+
go (L l (ValD _ d)) = goValD (L l d)
621+
#else
622+
go (L l (ValD d)) = goValD (L l d)
623+
#endif
624+
#if __GLASGOW_HASKELL__ >= 806
625+
go (L l (ForD _ ForeignImport { fd_name = n })) = pure (Decl LSP.SkFunction n [] l)
626+
#else
627+
go (L l (ForD ForeignImport { fd_name = n })) = pure (Decl LSP.SkFunction n [] l)
628+
#endif
629+
go _ = []
630+
631+
-- -----------------------------
632+
633+
goTyClD (L l (FamDecl { tcdFam = FamilyDecl { fdLName = n } })) = pure (Decl LSP.SkClass n [] l)
634+
goTyClD (L l (SynDecl { tcdLName = n })) = pure (Decl LSP.SkClass n [] l)
635+
goTyClD (L l (DataDecl { tcdLName = n, tcdDataDefn = HsDataDefn { dd_cons = cons } })) =
615636
pure (Decl LSP.SkClass n (concatMap processCon cons) l)
616-
go (L l (TyClD ClassDecl { tcdLName = n, tcdSigs = sigs, tcdATs = fams })) =
637+
goTyClD (L l (ClassDecl { tcdLName = n, tcdSigs = sigs, tcdATs = fams })) =
617638
pure (Decl LSP.SkInterface n children l)
618639
where children = famDecls ++ sigDecls
640+
#if __GLASGOW_HASKELL__ >= 806
641+
famDecls = concatMap (go . fmap (TyClD NoExt . FamDecl NoExt)) fams
642+
#else
619643
famDecls = concatMap (go . fmap (TyClD . FamDecl)) fams
644+
#endif
620645
sigDecls = concatMap processSig sigs
646+
#if __GLASGOW_HASKELL__ >= 806
647+
goTyClD (L _ (FamDecl _ (XFamilyDecl _))) = error "goTyClD"
648+
goTyClD (L _ (DataDecl _ _ _ _ (XHsDataDefn _))) = error "goTyClD"
649+
goTyClD (L _ (XTyClDecl _)) = error "goTyClD"
650+
#endif
651+
652+
-- -----------------------------
621653

622-
go (L l (ValD FunBind { fun_id = ln, fun_matches = MG { mg_alts = llms } })) =
654+
goValD :: LHsBind GM.GhcPs -> [Decl]
655+
goValD (L l (FunBind { fun_id = ln, fun_matches = MG { mg_alts = llms } })) =
623656
pure (Decl LSP.SkFunction ln wheres l)
624657
where
625658
wheres = concatMap (gomatch . unLoc) (unLoc llms)
626659
gomatch Match { m_grhss = GRHSs { grhssLocalBinds = lbs } } = golbs (unLoc lbs)
660+
#if __GLASGOW_HASKELL__ >= 806
661+
gomatch (Match _ _ _ (XGRHSs _)) = error "gomatch"
662+
gomatch (XMatch _) = error "gomatch"
663+
664+
golbs (HsValBinds _ (ValBinds _ lhsbs _)) = concatMap (go . fmap (ValD NoExt)) lhsbs
665+
#else
627666
golbs (HsValBinds (ValBindsIn lhsbs _ )) = concatMap (go . fmap ValD) lhsbs
667+
#endif
628668
golbs _ = []
629669

630-
go (L l (ValD PatBind { pat_lhs = p })) =
670+
goValD (L l (PatBind { pat_lhs = p })) =
631671
map (\n -> Decl LSP.SkVariable n [] l) $ hsNamessRdr p
632-
go (L l (ForD ForeignImport { fd_name = n })) = pure (Decl LSP.SkFunction n [] l)
633-
go _ = []
672+
673+
#if __GLASGOW_HASKELL__ >= 806
674+
goValD (L _ (FunBind _ _ (XMatchGroup _) _ _)) = error "goValD"
675+
goValD (L _ (VarBind _ _ _ _)) = error "goValD"
676+
goValD (L _ (AbsBinds _ _ _ _ _ _ _)) = error "goValD"
677+
goValD (L _ (PatSynBind _ _)) = error "goValD"
678+
goValD (L _ (XHsBindsLR _)) = error "goValD"
679+
#endif
680+
681+
-- -----------------------------
634682

635683
processSig :: LSig GM.GhcPs -> [Decl]
684+
#if __GLASGOW_HASKELL__ >= 806
685+
processSig (L l (ClassOpSig _ False names _)) =
686+
#else
636687
processSig (L l (ClassOpSig False names _)) =
688+
#endif
637689
map (\n -> Decl LSP.SkMethod n [] l) names
638690
processSig _ = []
639691

640692
processCon :: LConDecl GM.GhcPs -> [Decl]
641693
processCon (L l ConDeclGADT { con_names = names }) =
642694
map (\n -> Decl LSP.SkConstructor n [] l) names
695+
#if __GLASGOW_HASKELL__ >= 806
696+
processCon (L l ConDeclH98 { con_name = name, con_args = dets }) =
697+
#else
643698
processCon (L l ConDeclH98 { con_name = name, con_details = dets }) =
699+
#endif
644700
pure (Decl LSP.SkConstructor name xs l)
645701
where
646702
f (L fl ln) = Decl LSP.SkField ln [] fl
@@ -649,6 +705,9 @@ symbolProvider uri = pluginGetFile "ghc-mod symbolProvider: " uri $
649705
. cd_fld_names
650706
. unLoc) rs
651707
_ -> []
708+
#if __GLASGOW_HASKELL__ >= 806
709+
processCon (L _ (XConDecl _)) = error "processCon"
710+
#endif
652711

653712
goImport :: LImportDecl GM.GhcPs -> [Decl]
654713
goImport (L l ImportDecl { ideclName = lmn, ideclAs = as, ideclHiding = meis }) = pure im
@@ -660,15 +719,25 @@ symbolProvider uri = pluginGetFile "ghc-mod symbolProvider: " uri $
660719
xs = case meis of
661720
Just (False, eis) -> concatMap f (unLoc eis)
662721
_ -> []
663-
f (L l' (IEVar n)) = pure (Decl LSP.SkFunction (ieLWrappedName n) [] l')
722+
#if __GLASGOW_HASKELL__ >= 806
723+
f (L l' (IEVar _ n)) = pure (Decl LSP.SkFunction (ieLWrappedName n) [] l')
724+
f (L l' (IEThingAbs _ n)) = pure (Decl LSP.SkClass (ieLWrappedName n) [] l')
725+
f (L l' (IEThingAll _ n)) = pure (Decl LSP.SkClass (ieLWrappedName n) [] l')
726+
f (L l' (IEThingWith _ n _ vars fields)) =
727+
#else
728+
f (L l' (IEVar n)) = pure (Decl LSP.SkFunction (ieLWrappedName n) [] l')
664729
f (L l' (IEThingAbs n)) = pure (Decl LSP.SkClass (ieLWrappedName n) [] l')
665730
f (L l' (IEThingAll n)) = pure (Decl LSP.SkClass (ieLWrappedName n) [] l')
666731
f (L l' (IEThingWith n _ vars fields)) =
667-
let funcDecls = map (\n' -> Decl LSP.SkFunction (ieLWrappedName n') [] (getLoc n')) vars
732+
#endif
733+
let funcDecls = map (\n' -> Decl LSP.SkFunction (ieLWrappedName n') [] (getLoc n')) vars
668734
fieldDecls = map (\f' -> Decl LSP.SkField (flSelector <$> f') [] (getLoc f')) fields
669735
children = funcDecls ++ fieldDecls
670736
in pure (Decl LSP.SkClass (ieLWrappedName n) children l')
671737
f _ = []
738+
#if __GLASGOW_HASKELL__ >= 806
739+
goImport (L _ (XImportDecl _)) = error "goImport"
740+
#endif
672741

673742
declsToSymbolInf :: Decl -> IdeDeferM [LSP.DocumentSymbol]
674743
declsToSymbolInf (Decl kind (L nl rdrName) children l) =

‎src/Haskell/Ide/Engine/Plugin/Liquid.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE CPP #-}
22
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE DuplicateRecordFields #-}
34
{-# LANGUAGE OverloadedStrings #-}
45
{-# LANGUAGE NamedFieldPuns #-}
56
module Haskell.Ide.Engine.Plugin.Liquid where

‎submodules/apply-refact

Submodule apply-refact added at 2d50c81

‎submodules/brittany

Submodule brittany updated 29 files

0 commit comments

Comments
 (0)