reflection 2.1.8 → 2.1.9
raw patch · 9 files changed
+53/−163 lines, 9 filesdep −semigroupsdep −taggeddep ~basedep ~containers
Dependencies removed: semigroups, tagged
Dependency ranges changed: base, containers
Files
- CHANGELOG.markdown +3/−0
- examples/Constraints.hs +1/−1
- examples/FromJSON.hs +1/−11
- examples/Monoid.hs +1/−1
- examples/reflection-examples.cabal +6/−6
- fast/Data/Reflection.hs +23/−105
- reflection.cabal +11/−26
- slow/Data/Reflection.hs +1/−1
- tests/ReifyNatSpec.hs +6/−12
CHANGELOG.markdown view
@@ -1,3 +1,6 @@+# 2.1.9 [2024.12.04]+* Drop support for pre-8.0 versions of GHC.+ # 2.1.8 [2024.05.04] * Fix a memory leak in `reifyTypeable`.
examples/Constraints.hs view
@@ -10,7 +10,7 @@ import Data.Semigroup -- from semigroups #endif --- | Values in our dynamically constructed monoid over 'a'+-- | Values in our dynamically constructed monoid over @a@ newtype Lift (p :: * -> Constraint) (a :: *) (s :: *) = Lift { lower :: a } class ReifiableConstraint p where
examples/FromJSON.hs view
@@ -11,9 +11,7 @@ {-# LANGUAGE OverloadedStrings #-} import Data.Aeson -- from aeson-#if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.Key as Key-#endif import Data.Aeson.Types (Parser) import Data.Proxy -- from tagged import Data.Reflection -- from reflection@@ -36,15 +34,7 @@ fooParser :: Text -> Object -> Parser Foo fooParser prefix o = do- Foo <$> o .: (toKey prefix <> "field1") <*> o .: (toKey prefix <> "field2")--#if MIN_VERSION_aeson(2,0,0)-toKey :: Text -> Key.Key-toKey = Key.fromText-#else-toKey :: Text -> Text-toKey = id-#endif+ Foo <$> o .: (Key.fromText prefix <> "field1") <*> o .: (Key.fromText prefix <> "field2") -- A wrapper over Foo carrying a phantom type s newtype J a s = J { runJ :: a }
examples/Monoid.hs view
@@ -7,7 +7,7 @@ import Data.Semigroup -- from base #endif --- | Values in our dynamically-constructed 'Monoid' over 'a'+-- | Values in our dynamically-constructed 'Monoid' over @a@ newtype M a s = M { runM :: a } deriving (Eq,Ord) -- | A dictionary describing a 'Monoid'
examples/reflection-examples.cabal view
@@ -23,8 +23,11 @@ , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.8- , GHC == 9.4.5- , GHC == 9.6.2+ , GHC == 9.4.8+ , GHC == 9.6.6+ , GHC == 9.8.4+ , GHC == 9.10.1+ , GHC == 9.12.1 flag examples default: True@@ -50,10 +53,7 @@ if !flag(examples) buildable: False main-is: FromJSON.hs- build-depends:- -- TODO: Eventually, we should bump the lower version- -- bounds to >=2 so that we can remove some CPP in FromJSON.- aeson >= 1 && < 2.3,+ build-depends: aeson >= 2 && < 2.3, base >= 4.9 && < 5, microlens, microlens-aeson >= 2.5.1,
fast/Data/Reflection.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -6,36 +7,23 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-}-#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeOperators #-}-#define USE_TYPE_LITS 1-#endif #ifdef MIN_VERSION_template_haskell-# if __GLASGOW_HASKELL__ >= 800 -- TH-subset that works with stage1 & unregisterised GHCs {-# LANGUAGE TemplateHaskellQuotes #-}-# else-{-# LANGUAGE TemplateHaskell #-}-# endif #endif {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-cse #-} {-# OPTIONS_GHC -fno-full-laziness #-} {-# OPTIONS_GHC -fno-float-in #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# OPTIONS_GHC -fno-warn-unused-binds #-}--#ifndef MIN_VERSION_base-#define MIN_VERSION_base(x,y,z) 1-#endif+{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-unused-binds #-} ---------------------------------------------------------------------------- -- |@@ -77,10 +65,8 @@ -- * Reflection Reifies(..) , reify-#if __GLASGOW_HASKELL__ >= 708 , reifyNat , reifySymbol-#endif , reifyTypeable -- * Given , Given(..)@@ -115,30 +101,19 @@ #endif import Data.Bits--#if __GLASGOW_HASKELL__ < 710-import Data.Foldable-#endif--import Data.Semigroup as Sem+import Data.Coerce (Coercible, coerce) import Data.Proxy--#if __GLASGOW_HASKELL__ < 710-import Data.Traversable-#endif-+import Data.Semigroup as Sem import Data.Typeable import Data.Word import Foreign.Ptr import Foreign.StablePtr -#if (__GLASGOW_HASKELL__ >= 707) || (defined(MIN_VERSION_template_haskell) && USE_TYPE_LITS) import GHC.TypeLits-# if MIN_VERSION_base(4,10,0)+#if MIN_VERSION_base(4,10,0) import qualified Numeric.Natural as Numeric (Natural)-# elif __GLASGOW_HASKELL__ >= 707+#else import Control.Exception (ArithException(..), throw)-# endif #endif #ifdef __HUGS__@@ -155,10 +130,6 @@ import Unsafe.Coerce #endif -#if MIN_VERSION_base(4,7,0)-import Data.Coerce (Coercible, coerce)-#endif- #if MIN_VERSION_base(4,18,0) import qualified GHC.TypeNats as TN #endif@@ -190,16 +161,12 @@ reify a k = unsafeCoerce (Magic k :: Magic a r) (const a) Proxy {-# INLINE_UNSAFE_COERCE reify #-} -#if __GLASGOW_HASKELL__ >= 707 instance KnownNat n => Reifies n Integer where reflect = natVal instance KnownSymbol n => Reifies n String where reflect = symbolVal-#endif -#if __GLASGOW_HASKELL__ >= 708- -------------------------------------------------------------------------------- -- KnownNat --------------------------------------------------------------------------------@@ -220,29 +187,29 @@ -- 4 reifyNat :: forall r. Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r-# if MIN_VERSION_base(4,18,0)+#if MIN_VERSION_base(4,18,0) -- With base-4.18 or later, we can use the API in GHC.TypeNats to define this -- function directly. reifyNat n k = TN.withSomeSNat (fromInteger n :: Numeric.Natural) $ \(sn :: (SNat n)) -> TN.withKnownNat sn $ k (Proxy :: Proxy n) {-# INLINE reifyNat #-}-# else+#else -- On older versions of base, we resort to unsafeCoerce. reifyNat n k = unsafeCoerce (MagicNat k :: MagicNat r)-# if MIN_VERSION_base(4,10,0)+# if MIN_VERSION_base(4,10,0) -- Starting with base-4.10, the internal -- representation of KnownNat changed from Integer -- to Natural, so make sure to perform the same -- conversion before unsafeCoercing. (fromInteger n :: Numeric.Natural)-# else+# else (if n < 0 then throw Underflow else n)-# endif+# endif Proxy {-# INLINE_UNSAFE_COERCE reifyNat #-} newtype MagicNat r = MagicNat (forall (n :: Nat). KnownNat n => Proxy n -> r)-# endif+#endif -------------------------------------------------------------------------------- -- KnownSymbol@@ -260,19 +227,18 @@ -- >>> reifySymbol "hello" reflect -- "hello" reifySymbol :: forall r. String -> (forall (n :: Symbol). KnownSymbol n => Proxy n -> r) -> r-# if MIN_VERSION_base(4,18,0)+#if MIN_VERSION_base(4,18,0) -- With base-4.18 or later, we can use the API in GHC.TypeNats to define this -- function directly. reifySymbol s k = withSomeSSymbol s $ \(ss :: SSymbol s) -> withKnownSymbol ss (k (Proxy :: Proxy s)) {-# INLINE reifySymbol #-}-# else+#else -- On older versions of base, we resort to unsafeCoerce. reifySymbol n k = unsafeCoerce (MagicSymbol k :: MagicSymbol r) n Proxy {-# INLINE_UNSAFE_COERCE reifySymbol #-}-# endif+#endif newtype MagicSymbol r = MagicSymbol (forall (n :: Symbol). KnownSymbol n => Proxy n -> r)-#endif ------------------------------------------------------------------------------ -- Given@@ -344,9 +310,7 @@ -- in the \"Functional Pearl: Implicit Configurations\" paper by Oleg Kiselyov and Chung-Chieh Shan. -- -- @instance Num (Q Exp)@ provided in this package allows writing @$(3)@--- instead of @$(int 3)@. Sometimes the two will produce the same--- representation (if compiled without the @-DUSE_TYPE_LITS@ preprocessor--- directive).+-- instead of @$(int 3)@. int :: Int -> TypeQ int n = case quotRem n 2 of (0, 0) -> conT ''Z@@ -363,12 +327,6 @@ | n >= 0 = int n | otherwise = error "nat: negative" -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 704-instance Show (Q a) where- show _ = "Q"-instance Eq (Q a) where- _ == _ = False-#endif instance Num a => Num (Q a) where (+) = liftM2 (+) (*) = liftM2 (*)@@ -385,29 +343,13 @@ -- | This permits the use of $(5) as a type splice. instance Num Type where-#ifdef USE_TYPE_LITS LitT (NumTyLit a) + LitT (NumTyLit b) = LitT (NumTyLit (a+b)) a + b = AppT (AppT (VarT ''(+)) a) b LitT (NumTyLit a) * LitT (NumTyLit b) = LitT (NumTyLit (a*b)) (*) a b = AppT (AppT (VarT ''(GHC.TypeLits.*)) a) b-#if MIN_VERSION_base(4,8,0) a - b = AppT (AppT (VarT ''(-)) a) b-#else- (-) = error "Type.(-): undefined"-#endif fromInteger = LitT . NumTyLit-#else- (+) = error "Type.(+): undefined"- (*) = error "Type.(*): undefined"- (-) = error "Type.(-): undefined"- fromInteger n = case quotRem n 2 of- (0, 0) -> ConT ''Z- (q,-1) -> ConT ''PD `AppT` fromInteger q- (q, 0) -> ConT ''D `AppT` fromInteger q- (q, 1) -> ConT ''SD `AppT` fromInteger q- _ -> error "ghc is bad at math"-#endif abs = error "Type.abs" signum = error "Type.signum" @@ -442,27 +384,12 @@ signum = onProxyType1 signum fromInteger n = ConE 'Proxy `SigE` (ConT ''Proxy `AppT` fromInteger n) -#ifdef USE_TYPE_LITS addProxy :: Proxy a -> Proxy b -> Proxy (a + b) addProxy _ _ = Proxy mulProxy :: Proxy a -> Proxy b -> Proxy (a * b) mulProxy _ _ = Proxy-#if MIN_VERSION_base(4,8,0) subProxy :: Proxy a -> Proxy b -> Proxy (a - b) subProxy _ _ = Proxy-#else-subProxy :: Proxy a -> Proxy b -> Proxy c-subProxy _ _ = error "Exp.(-): undefined"-#endif--- fromInteger = LitT . NumTyLit-#else-addProxy :: Proxy a -> Proxy b -> Proxy c-addProxy _ _ = error "Exp.(+): undefined"-mulProxy :: Proxy a -> Proxy b -> Proxy c-mulProxy _ _ = error "Exp.(*): undefined"-subProxy :: Proxy a -> Proxy b -> Proxy c-subProxy _ _ = error "Exp.(-): undefined"-#endif #endif @@ -504,7 +431,7 @@ GO(T253,253) GO(T254,254) GO(T255,255) #define GO(Tn,n) \- newtype Tn = Tn Tn deriving Typeable; \+ newtype Tn = Tn Tn; \ instance B Tn where { \ reflectByte _ = n \ };@@ -522,9 +449,9 @@ _ -> impossible } -newtype W (b0 :: *) (b1 :: *) (b2 :: *) (b3 :: *) = W (W b0 b1 b2 b3) deriving Typeable-newtype StableBox (w0 :: *) (w1 :: *) (a :: *) = StableBox (StableBox w0 w1 a) deriving Typeable-newtype Stable (w0 :: *) (w1 :: *) (a :: *) = Stable (Stable w0 w1 a) deriving Typeable+newtype W (b0 :: *) (b1 :: *) (b2 :: *) (b3 :: *) = W (W b0 b1 b2 b3)+newtype StableBox (w0 :: *) (w1 :: *) (a :: *) = StableBox (StableBox w0 w1 a)+newtype Stable (w0 :: *) (w1 :: *) (a :: *) = Stable (Stable w0 w1 a) data Box a = Box a @@ -610,11 +537,7 @@ -- -- This can be necessary to work around the changes to @Data.Typeable@ in GHC HEAD. reifyTypeable :: Typeable a => a -> (forall (s :: *). (Typeable s, Reifies s a) => Proxy s -> r) -> r-#if MIN_VERSION_base(4,4,0) reifyTypeable a k = unsafeDupablePerformIO $ do-#else-reifyTypeable a k = unsafePerformIO $ do-#endif p <- newStablePtr (Box a) let n = stablePtrToIntPtr p reifyByte (fromIntegral n) (\s0 ->@@ -650,7 +573,7 @@ reifyMonoid f z m xs = reify (ReifiedMonoid f z) (unreflectedMonoid (m xs)) -- | Fold a value using its 'Foldable' instance using--- explicitly provided 'Monoid' operations. This is like 'fold'+-- explicitly provided 'Monoid' operations. This is like 'Data.Foldable.fold' -- where the 'Monoid' instance can be manually specified. -- -- @@@ -707,10 +630,5 @@ sequenceBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a) sequenceBy pur app = reifyApplicative pur app (traverse ReflectedApplicative) -#if MIN_VERSION_base(4,7,0) (#.) :: Coercible c b => (b -> c) -> (a -> b) -> (a -> c) (#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b-#else-(#.) :: (b -> c) -> (a -> b) -> a -> c-(#.) _ = unsafeCoerce-#endif
reflection.cabal view
@@ -1,5 +1,5 @@ name: reflection-version: 2.1.8+version: 2.1.9 license: BSD3 license-file: LICENSE author: Edward A. Kmett, Elliott Hird, Oleg Kiselyov and Chung-chieh Shan@@ -31,13 +31,7 @@ approach taken by this library, along with more motivating examples. . * Arnaud Spiwack's tutorial <https://www.tweag.io/posts/2017-12-21-reflection-tutorial.html All about reflection> explains how to use this library.-tested-with: GHC == 7.0.4- , GHC == 7.2.2- , GHC == 7.4.2- , GHC == 7.6.3- , GHC == 7.8.4- , GHC == 7.10.3- , GHC == 8.0.2+tested-with: GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5@@ -45,8 +39,11 @@ , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.8- , GHC == 9.4.5- , GHC == 9.6.2+ , GHC == 9.4.8+ , GHC == 9.6.6+ , GHC == 9.8.4+ , GHC == 9.10.1+ , GHC == 9.12.1 extra-source-files: .hlint.yaml@@ -81,27 +78,15 @@ if impl(ghc >= 8.6) ghc-options: -Wno-star-is-type - if impl(ghc >= 7.2)- default-extensions: Trustworthy+ default-extensions: Trustworthy build-depends:- base >= 2 && < 5-- if impl(ghc < 7.8)- build-depends:- tagged >= 0.4.4 && < 1-- if !impl(ghc >= 8.0)- build-depends:- semigroups >= 0.11 && < 0.21+ base >= 4.9 && < 5 default-language: Haskell98 if flag(template-haskell) && impl(ghc)- if !impl(ghc >= 8.0)- other-extensions: TemplateHaskell- -- else- -- other-extensions: TemplateHaskellQuotes -- Hackage doesn't know this extension yet+ -- other-extensions: TemplateHaskellQuotes -- Hackage doesn't know this extension yet build-depends: template-haskell if !flag(slow) && (impl(ghc) || impl(hugs))@@ -128,7 +113,7 @@ default-language: Haskell98 build-tool-depends: hspec-discover:hspec-discover >= 1.8 build-depends:- base >= 2 && < 5,+ base >= 4.9 && < 5, containers >= 0.1 && < 0.8, hspec >= 2 && < 3, QuickCheck >= 2 && < 3,
slow/Data/Reflection.hs view
@@ -9,7 +9,7 @@ {-# OPTIONS_GHC -fno-cse #-} {-# OPTIONS_GHC -fno-full-laziness #-} {-# OPTIONS_GHC -fno-float-in #-}-{-# OPTIONS_GHC -fno-warn-unused-binds #-}+{-# OPTIONS_GHC -Wno-unused-binds #-} ---------------------------------------------------------------------------- -- | -- Module : Data.Reflection
tests/ReifyNatSpec.hs view
@@ -2,20 +2,18 @@ {-# LANGUAGE ScopedTypeVariables #-} module ReifyNatSpec where -#if __GLASGOW_HASKELL__ >= 708 import Data.Reflection import Test.Hspec.QuickCheck import Test.QuickCheck (NonNegative(..)) -# if MIN_VERSION_base(4,10,0)+#if MIN_VERSION_base(4,10,0) import GHC.TypeNats (natVal) import Numeric.Natural (Natural)-# endif+#endif -# if __GLASGOW_HASKELL__ != 900+#if __GLASGOW_HASKELL__ != 900 import Control.Exception (ArithException(..), evaluate) import Test.QuickCheck (Negative(..))-# endif #endif import Test.Hspec@@ -25,11 +23,10 @@ spec :: Spec spec =-#if __GLASGOW_HASKELL__ >= 708 describe "reifyNat" $ do prop "reify positive Integers and reflect them back" $ \(NonNegative (i :: Integer)) -> reifyNat i $ \p -> reflect p `shouldBe` i-# if __GLASGOW_HASKELL__ != 900+#if __GLASGOW_HASKELL__ != 900 -- Inexplicably, this test fails on GHC 9.0 with hspec-2.8.4 or later. -- Moreover, I suspect that undefined behavior is involved in some way, -- as the output of hspec will occasionally be swallowed entirely. I have@@ -38,8 +35,8 @@ prop "should throw an Underflow exception on negative inputs" $ \(Negative (i :: Integer)) -> reifyNat i (evaluate . reflect) `shouldThrow` (== Underflow)-# endif-# if MIN_VERSION_base(4,10,0)+#endif+#if MIN_VERSION_base(4,10,0) it "should reflect very large Naturals correctly" $ do -- #41 let d42, d2_63, d2_64 :: Natural d42 = 42@@ -50,7 +47,4 @@ reifyNat (toInteger d2_63) $ \p -> natVal p `shouldBe` d2_63 reifyNat (toInteger (d2_64-1)) $ \p -> natVal p `shouldBe` d2_64-1 reifyNat (toInteger d2_64) $ \p -> natVal p `shouldBe` d2_64-# endif-#else- return () #endif