haskell-src-meta 0.8.7.1 → 0.8.8
raw patch · 4 files changed
+67/−9 lines, 4 filesdep ~haskell-src-extsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: haskell-src-exts
API changes (from Hackage documentation)
Files
- ChangeLog +5/−0
- haskell-src-meta.cabal +1/−1
- src/Language/Haskell/Meta/Syntax/Translate.hs +13/−1
- tests/Main.hs +48/−7
ChangeLog view
@@ -1,3 +1,8 @@+0.8.8+- Implement toDec for AnnPragma (by Matt Torrence)+- Add support for OverloadedLabels (by funketh)+- Fix order of promoted type tuples in resulting TH (by Alexander V. Nikolaev)+ 0.8.7.1 - Build on GHC 9.2 - Drop support for GHC < 8.2
haskell-src-meta.cabal view
@@ -1,5 +1,5 @@ name: haskell-src-meta-version: 0.8.7.1+version: 0.8.8 cabal-version: >= 1.10 build-type: Simple license: BSD3
src/Language/Haskell/Meta/Syntax/Translate.hs view
@@ -260,6 +260,9 @@ toExp e@Exts.IPVar{} = noTH "toExp" e toExp (Exts.Con _ n) = TH.ConE (toName n) toExp (Exts.Lit _ l) = TH.LitE (toLit l)+#if MIN_VERSION_template_haskell(2,13,0)+ toExp (Exts.OverloadedLabel _ s) = TH.LabelE s+#endif toExp (Exts.InfixApp _ e o f) = TH.UInfixE (toExp e) (toExp o) (toExp f) toExp (Exts.App _ e (Exts.TypeApp _ t)) = TH.AppTypeE (toExp e) (toType t) toExp (Exts.App _ e f) = TH.AppE (toExp e) (toExp f)@@ -421,7 +424,7 @@ Exts.PromotedString _ _ s -> TH.LitT $ TH.StrTyLit s Exts.PromotedCon _ _q n -> TH.PromotedT $ toName n Exts.PromotedList _ _q ts -> foldr (\t pl -> TH.PromotedConsT `TH.AppT` toType t `TH.AppT` pl) TH.PromotedNilT ts- Exts.PromotedTuple _ ts -> foldr (\t pt -> pt `TH.AppT` toType t) (TH.PromotedTupleT $ length ts) ts+ Exts.PromotedTuple _ ts -> foldl (\pt t -> pt `TH.AppT` toType t) (TH.PromotedTupleT $ length ts) ts Exts.PromotedUnit _ -> TH.PromotedT ''() toType (Exts.TyEquals _ t1 t2) = TH.EqualityT `TH.AppT` toType t1 `TH.AppT` toType t2 toType t@Exts.TySplice{} = noTH "toType" t@@ -595,6 +598,15 @@ (toDecs decls) where toFunDep (Exts.FunDep _ ls rs) = TH.FunDep (fmap toName ls) (fmap toName rs)++ toDec (Exts.AnnPragma _ ann) = TH.PragmaD (TH.AnnP (target ann) (expann ann))+ where+ target (Exts.Ann _ n _) = TH.ValueAnnotation (toName n)+ target (Exts.TypeAnn _ n _) = TH.TypeAnnotation (toName n)+ target (Exts.ModuleAnn _ _) = TH.ModuleAnnotation+ expann (Exts.Ann _ _ e) = toExp e+ expann (Exts.TypeAnn _ _ e) = toExp e+ expann (Exts.ModuleAnn _ e) = toExp e toDec x = todo "toDec" x
tests/Main.hs view
@@ -1,15 +1,22 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Main where -import qualified Control.Monad.Fail as Fail-import qualified Language.Haskell.Exts as Exts-import qualified Language.Haskell.Exts.Extension as Extension-import qualified Language.Haskell.Exts.Parser as Parser+import qualified Control.Monad.Fail as Fail+import Data.Data (Data, cast, gfoldl)+import Data.Functor.Const+ (Const (Const, getConst))+import qualified Language.Haskell.Exts as Exts+import qualified Language.Haskell.Exts.Extension as Extension+import qualified Language.Haskell.Exts.Parser as Parser import Language.Haskell.Meta.Parse-import qualified Language.Haskell.TH as TH-import Test.HUnit (Assertion, (@?=))+import Language.Haskell.Meta.Syntax.Translate+import qualified Language.Haskell.TH as TH+import Test.HUnit (Assertion, (@?=)) import Test.Tasty (TestTree, defaultMain, testGroup)-import Test.Tasty.HUnit (testCase)+import Test.Tasty.HUnit (testCase) type Test = TestTree @@ -19,11 +26,45 @@ tests :: [Test] tests = [ derivingClausesTest , typeAppTest+ , orderInTypeTuples ] derivingClausesTest :: Test derivingClausesTest = testCase "Deriving clauses preserved" $ roundTripDecls "data Foo = Foo deriving (A, B, C)"++orderInTypeTuples :: Test+orderInTypeTuples =+ testCase "Ensure that type tuples reconstructed in proper order" $ do+ expected @?= actual+ where+ expected :: [TH.TyLit]+ expected = collectAll (toExp parsed)+ actual = [TH.StrTyLit "a", TH.StrTyLit "b"]++ parsed :: Exts.Exp Exts.SrcSpanInfo+ parsed = case Exts.parseExpWithMode mode "foo @'(\"a\", \"b\")" of+ Exts.ParseOk v -> v+ e -> error $ show e+ mode :: Exts.ParseMode+ mode = Exts.defaultParseMode {+ Exts.extensions = [+ Exts.EnableExtension Exts.TypeApplications+ , Exts.EnableExtension Exts.DataKinds+ ]+ }++collectAll :: (Data a, Data b) => a -> [b]+collectAll = ($ []) . go+ where+ go :: forall a b. (Data a, Data b) => a -> [b] -> [b]+ go = \x ->+ case cast x of+ Just x' -> (x' :)+ Nothing -> getConst $ gfoldl ap (const $ Const id) x+ where+ ap :: Data x => Const ([b] -> [b]) (x -> y) -> x -> Const ([b] -> [b]) y+ ap (Const acc) x = Const $ acc . go x typeAppMode :: Exts.ParseMode typeAppMode = Parser.defaultParseMode { Parser.extensions = [Extension.EnableExtension Extension.TypeApplications] }