on master help sign in
Grenade.Core.Shape: Fix for ghc 8.8

For version 2.6 of the singletons library (which is version locked to the GHC version) switched the 'Sing' type from a data family to a type family. This commit uses CPP hackery to workaround this change. Closes: https://github.com/HuwCampbell/grenade/issues/94

commitb70f6a8d19226ee504ee2be42206d24f865138cf authorErik de Castro Lopo <erikd@mega-nerd.com> dateSun 19 Jan 2020, 10:51 (7 years ago) parentfed6eb2
3 files changed+29−9
src/Grenade/Core/Shape.hs+18−2 test/Test/Hedgehog/Hmatrix.hs+3−2 test/Test/Hedgehog/TypeLits.hs+8−5
src/Grenade/Core/Shape.hs+18−2
@@ -19,9 +19,12 @@ Stability : experimental
1919
2020-}
2121module Grenade.Core.Shape (
22− Shape (..)
23− , S (..)
22+ S (..)
23+ , Shape (..)
2424 , Sing (..)
25+#if MIN_VERSION_singletons(2,6,0)
26+ , SShape (..)
27+#endif
2528
2629 , randomOfShape
2730 , fromStorable
@@ -30,6 +33,9 @@ module Grenade.Core.Shape (
3033import Control.DeepSeq (NFData (..))
3134import Control.Monad.Random ( MonadRandom, getRandom )
3235
36+#if MIN_VERSION_base(4,13,0)
37+import Data.Kind (Type)
38+#endif
3339import Data.Proxy
3440import Data.Serialize
3541import Data.Singletons
@@ -87,10 +93,20 @@ deriving instance Show (S n)
8793-- These could probably be derived with template haskell, but this seems
8894-- clear and makes adding the KnownNat constraints simple.
8995-- We can also keep our code TH free, which is great.
96+#if MIN_VERSION_singletons(2,6,0)
97+-- In singletons 2.6 Sing switched from a data family to a type family.
98+type instance Sing = SShape
99+
100+data SShape :: Shape -> Type where
101+ D1Sing :: Sing a -> SShape ('D1 a)
102+ D2Sing :: Sing a -> Sing b -> SShape ('D2 a b)
103+ D3Sing :: KnownNat (a * c) => Sing a -> Sing b -> Sing c -> SShape ('D3 a b c)
104+#else
90105data instance Sing (n :: Shape) where
91106 D1Sing :: Sing a -> Sing ('D1 a)
92107 D2Sing :: Sing a -> Sing b -> Sing ('D2 a b)
93108 D3Sing :: KnownNat (a * c) => Sing a -> Sing b -> Sing c -> Sing ('D3 a b c)
109+#endif
94110
95111instance KnownNat a => SingI ('D1 a) where
96112 sing = D1Sing sing
test/Test/Hedgehog/Hmatrix.hs+3−2
@@ -1,7 +1,8 @@
1−{-# LANGUAGE RankNTypes #-}
21{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
2+{-# LANGUAGE KindSignatures #-}
43{-# LANGUAGE GADTs #-}
4+{-# LANGUAGE RankNTypes #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
56
67module Test.Hedgehog.Hmatrix where
78
test/Test/Hedgehog/TypeLits.hs+8−5
@@ -7,17 +7,20 @@
77{-# LANGUAGE GADTs #-}
88module Test.Hedgehog.TypeLits where
99
10−import Data.Constraint
11−import Data.Singletons
10+import Data.Constraint (Dict (..))
11+import Data.Singletons (Proxy (..), Sing (..), SomeSing (..), sing)
12+#if MIN_VERSION_singletons(2,6,0)
13+import Data.Singletons.TypeLits (SNat (..))
14+#endif
1215
1316import Hedgehog (Gen)
1417import qualified Hedgehog.Gen as Gen
1518
1619import Grenade
1720
18−import GHC.TypeLits
19−import GHC.TypeLits.Witnesses hiding (SNat)
20−import Test.Hedgehog.Compat
21+import GHC.TypeLits (SomeNat (..), natVal, someNatVal)
22+import GHC.TypeLits.Witnesses ((%*), natDict)
23+import Test.Hedgehog.Compat (choose)
2124
2225genNat :: Gen SomeNat
2326genNat = do