th-desugar 1.5 → 1.5.1

raw patch · 10 files changed

+63/−26 lines, 10 filesdep +th-orphansdep ~template-haskelldep ~th-liftPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: th-orphans

Dependency ranges changed: template-haskell, th-lift

API changes (from Hackage documentation)

Files

• CHANGES.md +7/−0
• Language/Haskell/TH/Desugar/Core.hs +2/−0
• Language/Haskell/TH/Desugar/Expand.hs +5/−1
• Language/Haskell/TH/Desugar/Lift.hs +4/−13
• Language/Haskell/TH/Desugar/Match.hs +3/−4
• Language/Haskell/TH/Desugar/Sweeten.hs +14/−2
• Language/Haskell/TH/Desugar/Util.hs +6/−1
• Test/Run.hs +9/−0
• Test/Splices.hs +7/−1
• th-desugar.cabal +6/−4

@@ -1,3 +1,10 @@+Version 1.5.1+-------------+* Thanks to David Fox (@ddssff), sweetening now tries to use more of TH's `Type`+constructors.++* Also thanks to David Fox, depend usefully on the th-orphans package.+ Version 1.5 ----------- * There is now a facility to register a list of `Dec` that internal reification

@@ -16,7 +16,9 @@ import Language.Haskell.TH hiding (match, clause, cxt) import Language.Haskell.TH.Syntax hiding (lift) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative+#endif import Control.Monad hiding (mapM) import Control.Monad.Zip import Control.Monad.Writer hiding (mapM)

@@ -28,7 +28,9 @@ import qualified Data.Map as M import qualified Data.Set as S import Control.Monad+#if __GLASGOW_HASKELL__ < 709 import Control.Applicative+#endif import Language.Haskell.TH hiding (cxt) import Language.Haskell.TH.Syntax ( Quasi(..) ) import Data.Data@@ -42,7 +44,9 @@ import Language.Haskell.TH.Desugar.Reify  -- | Expands all type synonyms in a desugared type. Also expands open type family--- applications, as long as the arguments have no free variables.+-- applications, as long as the arguments have no free variables. Attempts to+-- expand closed type family applications, but aborts the moment it spots anything+-- strange, like a nested type family application or type variable. expandType :: DsMonad q => DType -> q DType expandType = go []   where

@@ -20,23 +20,14 @@ module Language.Haskell.TH.Desugar.Lift () where  import Language.Haskell.TH.Desugar+import Language.Haskell.TH.Instances () import Language.Haskell.TH.Lift-import Language.Haskell.TH-#if __GLASGOW_HASKELL__ <= 708-import Data.Word-#endif  $(deriveLiftMany [ ''DExp, ''DPat, ''DType, ''DKind, ''DPred, ''DTyVarBndr                  , ''DMatch, ''DClause, ''DLetDec, ''DDec, ''DCon                  , ''DConFields, ''DForeign, ''DPragma, ''DRuleBndr, ''DTySynEqn                  , ''NewOrData-                 , ''Lit, ''TyLit, ''Fixity, ''FixityDirection, ''Strict-                 , ''Callconv, ''Safety, ''Inline, ''RuleMatch, ''Phases-                 , ''AnnTarget, ''FunDep, ''FamFlavour, ''Role ])--#if __GLASGOW_HASKELL__ <= 708--- Other type liftings:-                                      -instance Lift Word8 where-  lift word = return $ (VarE 'fromInteger) `AppE` (LitE $ IntegerL (toInteger word))+#if __GLASGOW_HASKELL__ < 707+                 , ''AnnTarget, ''Role #endif+                 ])

@@ -20,10 +20,13 @@  import Prelude hiding ( fail, exp ) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative+#endif import Control.Monad hiding ( fail ) import qualified Data.Set as S import qualified Data.Map as Map+import Language.Haskell.TH.Instances () import Language.Haskell.TH.Syntax  import Language.Haskell.TH.Desugar.Core@@ -112,10 +115,6 @@         PgAny   -> matchVariables vars (drop_group eqns)      drop_group = map snd--#if __GLASGOW_HASKELL__ <= 708-deriving instance Ord Lit   -- ew. necessary for `subGroup`-#endif  -- analogous to GHC's tidyEqnInfo tidyClause :: DsMonad q => Name -> EquationInfo -> q (DExp -> DExp, EquationInfo)

@@ -7,6 +7,7 @@ -}  {-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}  ----------------------------------------------------------------------------- -- |@@ -173,7 +174,18 @@ typeToTH (DAppT t1 t2)          = AppT (typeToTH t1) (typeToTH t2) typeToTH (DSigT ty ki)          = SigT (typeToTH ty) (kindToTH ki) typeToTH (DVarT n)              = VarT n-typeToTH (DConT n)              = ConT n+typeToTH (DConT n)+  | n == ''[]                   = ListT+#if __GLASGOW_HASKELL__ >= 709+  | n == ''(~)                  = EqualityT+#endif+  | n == '[]                    = PromotedNilT+  | n == '(:)                   = PromotedConsT+  | Just deg <- tupleNameDegree_maybe n        = if isDataName n+                                                 then PromotedTupleT deg+                                                 else TupleT deg+  | Just deg <- unboxedTupleNameDegree_maybe n = UnboxedTupleT deg+  | otherwise                   = ConT n typeToTH DArrowT                = ArrowT typeToTH (DLitT lit)            = LitT lit @@ -202,7 +214,7 @@ predToTH (DAppPr p t) = AppT (predToTH p) (typeToTH t) predToTH (DSigPr p k) = SigT (predToTH p) (kindToTH k) predToTH (DVarPr n)   = VarT n-predToTH (DConPr n)   = ConT n+predToTH (DConPr n)   = typeToTH (DConT n) #endif  kindToTH :: DKind -> Kind

@@ -11,7 +11,7 @@ module Language.Haskell.TH.Desugar.Util (   newUniqueName,   impossible, -  nameOccursIn, allNamesIn, mkTypeName, mkDataName,+  nameOccursIn, allNamesIn, mkTypeName, mkDataName, isDataName,   stripVarP_maybe, extractBoundNamesStmt,   concatMapM, mapMaybeM, expectJustM,   liftSndM, liftThdOf3M, stripPlainTV_maybe,@@ -67,6 +67,11 @@     Nothing -> do       Loc { loc_package = pkg, loc_module = modu } <- qLocation       return $ mkNameG_d pkg modu str++-- | Is this name a data constructor name? A 'False' answer means "unsure".+isDataName :: Name -> Bool+isDataName (Name _ (NameG DataName _ _)) = True+isDataName _                             = False  -- | Extracts the name out of a variable pattern, or returns @Nothing@ stripVarP_maybe :: Pat -> Maybe Name

@@ -29,7 +29,9 @@ import qualified Language.Haskell.TH.Syntax as Syn ( lift )  import Control.Monad+#if __GLASGOW_HASKELL__ < 709 import Control.Applicative+#endif  #if __GLASGOW_HASKELL__ >= 707 import Data.Proxy@@ -234,6 +236,13 @@     it "extracts record selectors" $ test_rec_sels      it "works with standalone deriving" $ test_standalone_deriving++    -- Remove map pprints here after switch to th-orphans+    zipWithM (\t t' -> it ("can do Type->DType->Type of " ++ t) $ t == t')+             $(sequence round_trip_types >>= Syn.lift . map pprint)+             $(sequence round_trip_types >>=+               mapM (\ t -> withLocalDeclarations [] (dsType t >>= expandType >>= return . typeToTH)) >>=+              Syn.lift . map pprint)      zipWith3M (\a b n -> it ("reifies local definition " ++ show n) $ a == b)       local_reifications normal_reifications [1..]

@@ -362,4 +362,10 @@   , [| let foo [] = True            foo _  = False in (foo [], foo "hi") |]   ]-                             ++-- These foralls are needed because of bug trac9262, fixed in ghc-7.10.+round_trip_types :: [TypeQ]+round_trip_types =+    [ [t|forall a. a ~ Int => a|]+    , [t|forall a. [a]|]+    , [t|forall a b. (a,b)|] ]

@@ -1,5 +1,5 @@ name:           th-desugar-version:        1.5+version:        1.5.1 cabal-version:  >= 1.10 synopsis:       Functions to desugar Template Haskell homepage:       http://www.cis.upenn.edu/~eir/packages/th-desugar@@ -26,7 +26,7 @@ source-repository this   type:     git   location: https://github.com/goldfirere/th-desugar.git-  tag:      v1.5+  tag:      v1.5.1  library   build-depends:      @@ -35,7 +35,8 @@       containers >= 0.5,       mtl >= 2.1,       syb >= 0.4,-      th-lift >= 0.6.1+      th-lift >= 0.6.1,+      th-orphans >= 0.9.1   default-extensions: TemplateHaskell   exposed-modules:    Language.Haskell.TH.Desugar,                       Language.Haskell.TH.Desugar.Sweeten,@@ -65,4 +66,5 @@       syb >= 0.4,       HUnit >= 1.2,       hspec >= 1.3,-      th-lift >= 0.6.1+      th-lift >= 0.6.1,+      th-orphans >= 0.9.1