diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +0.6.0.3 -> 0.6.0.4: +- Drop support for GHC 6.12 +- Move to HSE 1.14 + 0.6.0.2 -> 0.6.0.3: - Update th-orphans dependency - Some dependency loosening in anticipation of GHC 7.8 diff --git a/haskell-src-meta.cabal b/haskell-src-meta.cabal --- a/haskell-src-meta.cabal +++ b/haskell-src-meta.cabal @@ -1,5 +1,5 @@ name: haskell-src-meta -version: 0.6.0.3 +version: 0.6.0.4 cabal-version: >= 1.6 build-type: Simple license: BSD3 @@ -10,8 +10,7 @@ maintainer: Ben Millwood bug-reports: https://github.com/benmachine/haskell-src-meta/issues stability: experimental -tested-with: GHC == 6.12.3, GHC == 7.0.4, GHC == 7.2.2, - GHC == 7.4.2, GHC == 7.6.2 +tested-with: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2, GHC == 7.6.2 synopsis: Parse source to template-haskell abstract syntax. description: The translation from haskell-src-exts abstract syntax to template-haskell abstract syntax isn't 100% complete yet. @@ -20,7 +19,7 @@ library build-depends: base >= 4.2 && < 4.8, - haskell-src-exts >= 1.8 && < 1.14, + haskell-src-exts == 1.14.*, pretty >= 1.0 && < 1.2, syb >= 0.1 && < 0.5, th-orphans >= 0.5 && < 0.8 diff --git a/src/Language/Haskell/Meta/Parse.hs b/src/Language/Haskell/Meta/Parse.hs --- a/src/Language/Haskell/Meta/Parse.hs +++ b/src/Language/Haskell/Meta/Parse.hs @@ -57,36 +57,13 @@ myDefaultParseMode :: ParseMode myDefaultParseMode = ParseMode {parseFilename = [] - ,extensions = myDefaultExtensions + ,baseLanguage = Haskell2010 + ,extensions = map EnableExtension myDefaultExtensions ,ignoreLinePragmas = False ,ignoreLanguagePragmas = False - ,fixities = defaultFixities} - --- This is a silly hack to make things work on haskell-src-exts versions --- 1.10 and 1.11 simultaneously. I justify it because myDefaultParseMode is --- deprecated anyway. --- --- Essentially we want defaultFixities to be baseFixities or Just baseFixities --- as appropriate. We do this without requiring FlexibleInstances using the --- same trick as Show on lists does. -class DefaultFixities a where - defaultFixities :: a - defaultFixities = - error "Language.Haskell.Meta.Parse.defaultFixities undefined" - defaultFixityList :: [a] - defaultFixityList = - error "Language.Haskell.Meta.Parse.defaultFixityList undefined" - -instance DefaultFixities Fix.Fixity where - defaultFixityList = baseFixities - -instance DefaultFixities a => DefaultFixities [a] where - defaultFixities = defaultFixityList - -instance DefaultFixities a => DefaultFixities (Maybe a) where - defaultFixities = Just defaultFixities + ,fixities = Just baseFixities} -myDefaultExtensions :: [Extension] +myDefaultExtensions :: [KnownExtension] myDefaultExtensions = [PostfixOperators ,QuasiQuotes ,UnicodeSyntax diff --git a/src/Language/Haskell/Meta/Syntax/Translate.hs b/src/Language/Haskell/Meta/Syntax/Translate.hs --- a/src/Language/Haskell/Meta/Syntax/Translate.hs +++ b/src/Language/Haskell/Meta/Syntax/Translate.hs @@ -38,8 +38,13 @@ -- When to use each of these isn't always clear: prefer 'todo' if unsure. noTH :: Show e => String -> e -> a noTH fun thing = error . concat $ [moduleName, ".", fun, - ": no TH representation for: ", show thing] + ": template-haskell has no representation for: ", show thing] +noTHyet :: Show e => String -> String -> e -> a +noTHyet fun minVersion thing = error . concat $ [moduleName, ".", fun, + ": template-haskell-", VERSION_template_haskell, " (< ", minVersion, ")", + " has no representation for: ", show thing] + todo :: Show e => String -> e -> a todo fun thing = error . concat $ [moduleName, ".", fun, ": not implemented: ", show thing] @@ -149,17 +154,13 @@ toLit (Hs.PrimString a) = StringPrimL (map toWord8 a) where toWord8 = fromIntegral . ord -#elif MIN_VERSION_template_haskell(2,5,0) - toLit (Hs.PrimString a) = StringPrimL a #else - toLit l@Hs.PrimString{} = noTH "toLit" l + toLit (Hs.PrimString a) = StringPrimL a #endif toLit (Hs.PrimInt a) = IntPrimL a toLit (Hs.PrimFloat a) = FloatPrimL a toLit (Hs.PrimDouble a) = DoublePrimL a -#if MIN_VERSION_template_haskell(2,4,0) toLit (Hs.PrimWord a) = WordPrimL a -#endif ----------------------------------------------------------------------------- @@ -186,7 +187,12 @@ toPat (Hs.PInfixApp p n q)= InfixP (toPat p) (toName n) (toPat q) #endif toPat (Hs.PApp n ps) = ConP (toName n) (fmap toPat ps) - toPat (Hs.PTuple ps) = TupP (fmap toPat ps) + toPat (Hs.PTuple Hs.Boxed ps) = TupP (fmap toPat ps) +#if MIN_VERSION_template_haskell(2,6,0) + toPat (Hs.PTuple Hs.Unboxed ps) = UnboxedTupP (fmap toPat ps) +#else + toPat p@(Hs.PTuple Hs.Unboxed _) = noTHyet "toPat" "2.6.0" p +#endif toPat (Hs.PList ps) = ListP (fmap toPat ps) #if MIN_VERSION_template_haskell(2,7,0) toPat (Hs.PParen p) = ParensP (toPat p) @@ -199,9 +205,7 @@ toPat (Hs.PWildCard) = WildP toPat (Hs.PIrrPat p) = TildeP (toPat p) toPat (Hs.PatTypeSig _ p t) = SigP (toPat p) (toType t) -#if MIN_VERSION_template_haskell(2,5,0) toPat (Hs.PViewPat e p) = ViewP (toExp e) (toPat p) -#endif -- regular pattern toPat p@Hs.PRPat{} = noTH "toPat" p -- XML stuff @@ -209,9 +213,7 @@ toPat p@Hs.PXETag{} = noTH "toPat" p toPat p@Hs.PXPcdata{} = noTH "toPat" p toPat p@Hs.PXPatTag{} = noTH "toPat" p -#if MIN_VERSION_template_haskell(2,4,0) toPat (Hs.PBangPat p) = BangP (toPat p) -#endif /* MIN_VERSION_template_haskell(2,4,0) */ toPat p = todo "toPat" p ----------------------------------------------------------------------------- @@ -246,7 +248,12 @@ toExp (Hs.If a b c) = CondE (toExp a) (toExp b) (toExp c) toExp (Hs.Do ss) = DoE (map toStmt ss) toExp e@(Hs.MDo _) = noTH "toExp" e - toExp (Hs.Tuple xs) = TupE (fmap toExp xs) + toExp (Hs.Tuple Hs.Boxed xs) = TupE (fmap toExp xs) +#if MIN_VERSION_template_haskell(2,6,0) + toExp (Hs.Tuple Hs.Unboxed xs) = UnboxedTupE (fmap toExp xs) +#else + toExp e@(Hs.Tuple Hs.Unboxed _) = noTHyet "toExp" "2.6.0" e +#endif toExp (Hs.List xs) = ListE (fmap toExp xs) #if MIN_VERSION_template_haskell(2,7,0) toExp (Hs.Paren e) = ParensE (toExp e) @@ -302,13 +309,10 @@ instance ToName Name where toName = id -#if MIN_VERSION_template_haskell(2,4,0) instance ToName TyVarBndr where toName (PlainTV n) = n toName (KindedTV n _) = n -#endif /* !MIN_VERSION_template_haskell(2,4,0) */ -#if MIN_VERSION_template_haskell(2,4,0) #if MIN_VERSION_template_haskell(2,8,0) instance ToType Hs.Kind where @@ -328,20 +332,13 @@ toKind (Hs.KindFn k1 k2) = ArrowK (toKind k1) (toKind k2) toKind (Hs.KindParen kp) = toKind kp toKind k@Hs.KindBang = noTH "toKind" k -toKind k@Hs.KindVar{} = noTH "toKind" k +toKind k@Hs.KindVar{} = noTHyet "toKind" "2.8.0" k #endif /* !MIN_VERSION_template_haskell(2,8,0) */ -#endif /* !MIN_VERSION_template_haskell(2,4,0) */ -#if MIN_VERSION_template_haskell(2,4,0) toTyVar :: Hs.TyVarBind -> TyVarBndr toTyVar (Hs.KindedVar n k) = KindedTV (toName n) (toKind k) toTyVar (Hs.UnkindedVar n) = PlainTV (toName n) -#else /* !MIN_VERSION_template_haskell(2,4,0) */ -toTyVar :: Hs.TyVarBind -> Name -toTyVar (Hs.KindedVar n _) = toName n -toTyVar (Hs.UnkindedVar n) = toName n -#endif /* !MIN_VERSION_template_haskell(2,4,0) */ instance ToType Hs.Type where toType (Hs.TyForall tvbM cxt t) = ForallT (maybe [] (fmap toTyVar) tvbM) (toCxt cxt) (toType t) @@ -354,7 +351,7 @@ #if MIN_VERSION_template_haskell(2,6,0) Hs.Unboxed -> UnboxedTupleT #else - Hs.Unboxed -> noTH "toType TyTuple" (Hs.TyTuple b ts) + Hs.Unboxed -> noTHyet "toType TyTuple" "2.6.0" (Hs.TyTuple b ts) #endif toType (Hs.TyApp a b) = AppT (toType a) (toType b) toType (Hs.TyVar n) = VarT (toName n) @@ -373,17 +370,10 @@ toCxt :: Hs.Context -> Cxt toCxt = fmap toPred where -#if MIN_VERSION_template_haskell(2,4,0) toPred (Hs.ClassA n ts) = ClassP (toName n) (fmap toType ts) toPred (Hs.InfixA t1 n t2) = ClassP (toName n) (fmap toType [t1, t2]) toPred (Hs.EqualP t1 t2) = EqualP (toType t1) (toType t2) toPred a@Hs.IParam{} = noTH "toCxt" a -#else - toPred (Hs.ClassA n ts) = foldAppT (ConT (toName n)) (fmap toType ts) - toPred (Hs.InfixA t1 n t2) = foldAppT (ConT (toName n)) (fmap toType [t1, t2]) - toPred a@Hs.EqualP{} = noTH "toCxt" a - toPred a@Hs.IParam{} = noTH "toCxt" a -#endif foldAppT :: Type -> [Type] -> Type foldAppT t ts = foldl' AppT t ts @@ -440,7 +430,6 @@ = let xs = fmap (flip SigD (toType t) . toName) ns in case xs of x:_ -> x; [] -> error "toDec: malformed TypeSig!" -#if MIN_VERSION_template_haskell(2,4,0) #if MIN_VERSION_template_haskell(2,8,0) toDec (Hs.InlineConlikeSig _ act qn) = PragmaD $ @@ -466,8 +455,6 @@ toDec (Hs.DataFamDecl _ _ n ns k) = FamilyD DataFam (toName n) (fmap toTyVar ns) (fmap toKind k) -#endif /* MIN_VERSION_template_haskell(2,4,0) */ - toDec a@(Hs.FunBind mtchs) = hsMatchesToFunD mtchs toDec (Hs.PatBind _ p tM rhs bnds) = ValD ((maybe id (flip SigP . toType) @@ -597,11 +584,7 @@ toDecs a = [toDec a] collectVars e = case e of -#if MIN_VERSION_template_haskell(2,4,0) VarT n -> [PlainTV n] -#else /* !MIN_VERSION_template_haskell(2,4,0) */ - VarT n -> [n] -#endif /* !MIN_VERSION_template_haskell(2,4,0) */ AppT t1 t2 -> nub $ collectVars t1 ++ collectVars t2 ForallT ns _ t -> collectVars t \\ ns _ -> [] diff --git a/src/Language/Haskell/Meta/Utils.hs b/src/Language/Haskell/Meta/Utils.hs --- a/src/Language/Haskell/Meta/Utils.hs +++ b/src/Language/Haskell/Meta/Utils.hs @@ -163,7 +163,6 @@ (t',env4,new4) = renameT env3 new3 t in (ForallT ns'' cxt' t', env4, new4) where -#if MIN_VERSION_template_haskell(2,4,0) unVarT (VarT n) = PlainTV n renamePreds = renameThings renamePred @@ -176,12 +175,7 @@ (t2', env2, new2) = renameT env1 new1 t2 in (EqualP t1' t2', env2, new2) -#else /* !MIN_VERSION_template_haskell(2,4,0) */ - unVarT (VarT n) = n - renamePreds = renameTs -#endif /* !MIN_VERSION_template_haskell(2,4,0) */ - -- | Remove qualification, etc. normaliseName :: Name -> Name normaliseName = mkName . nameBase @@ -236,11 +230,7 @@ decCons _ = [] -#if MIN_VERSION_template_haskell(2,4,0) decTyVars :: Dec -> [TyVarBndr] -#else /* !MIN_VERSION_template_haskell(2,4,0) */ -decTyVars :: Dec -> [Name] -#endif /* !MIN_VERSION_template_haskell(2,4,0) */ decTyVars (DataD _ _ ns _ _) = ns decTyVars (NewtypeD _ _ ns _ _) = ns decTyVars (TySynD _ ns _) = ns