Skip to content

Commit ac341f4

Browse files
ShimuuarShimuuar
committed
Make sure deriving examples actually compile
Doctests do awful job checking it. Constructor may be in scope for doctest and not in scope for client code
1 parent 5aade90 commit ac341f4

File tree

4 files changed

+155
-1
lines changed

4 files changed

+155
-1
lines changed

‎vector/src/Data/Vector/Unboxed.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@
6868
-- @
6969
module Data.Vector.Unboxed (
7070
-- * Unboxed vectors
71-
Vector(V_UnboxAs, V_UnboxViaPrim), MVector(..), Unbox,
71+
Vector(V_UnboxAs, V_UnboxViaPrim, V_UnboxViaStorable), MVector(..), Unbox,
7272

7373
-- * Accessors
7474

‎vector/tests/Main.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ import qualified Tests.Vector.Strict
88
import qualified Tests.Vector.Unboxed
99
import qualified Tests.Bundle
1010
import qualified Tests.Move
11+
import qualified Tests.Deriving ()
1112

1213
import Test.Tasty (defaultMain,testGroup)
1314

‎vector/tests/Tests/Deriving.hs‎

Lines changed: 151 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,151 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE FlexibleInstances #-}
4+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5+
{-# LANGUAGE MagicHash #-}
6+
{-# LANGUAGE MultiParamTypeClasses #-}
7+
{-# LANGUAGE PolyKinds #-}
8+
{-# LANGUAGE StandaloneDeriving #-}
9+
{-# LANGUAGE TypeApplications #-}
10+
{-# LANGUAGE TypeFamilies #-}
11+
{-# LANGUAGE TypeOperators #-}
12+
{-# LANGUAGE UnboxedTuples #-}
13+
#if MIN_VERSION_base(4,12,0)
14+
{-# LANGUAGE DerivingVia #-}
15+
#endif
16+
-- |
17+
-- These tests make sure that derived Unbox instances actually works.
18+
-- It's distressingly easy to forget to export some constructor and
19+
-- make seemingly fine code noncompilable.
20+
--
21+
-- We're only interested in checking whether examples compiling.
22+
-- Doctests aren't reliable in ensuring that!
23+
module Tests.Deriving () where
24+
25+
import Control.DeepSeq
26+
import qualified Data.Vector.Generic as VG
27+
import qualified Data.Vector.Generic.Mutable as VGM
28+
import qualified Data.Vector.Storable as VS
29+
import qualified Data.Vector.Primitive as VP
30+
import qualified Data.Vector.Unboxed as VU
31+
32+
#if MIN_VERSION_base(4,12,0)
33+
----------------------------------------------------------------
34+
-- Primitive
35+
36+
newtype FooP1 = FooP1 Int deriving VP.Prim
37+
38+
newtype instance VU.MVector s FooP1 = MV_FooP1 (VP.MVector s FooP1)
39+
newtype instance VU.Vector FooP1 = V_FooP1 (VP.Vector FooP1)
40+
deriving via (VU.UnboxViaPrim FooP1) instance VGM.MVector VU.MVector FooP1
41+
deriving via (VU.UnboxViaPrim FooP1) instance VG.Vector VU.Vector FooP1
42+
instance VU.Unbox FooP1
43+
44+
45+
46+
newtype FooP2 = FooP2 Int
47+
48+
newtype instance VU.MVector s FooP2 = MV_FooP2 (VP.MVector s Int)
49+
newtype instance VU.Vector FooP2 = V_FooP2 (VP.Vector Int)
50+
deriving via (VU.UnboxViaPrim Int) instance VGM.MVector VU.MVector FooP2
51+
deriving via (VU.UnboxViaPrim Int) instance VG.Vector VU.Vector FooP2
52+
instance VU.Unbox FooP2
53+
54+
55+
----------------------------------------------------------------
56+
-- Storable
57+
58+
newtype FooS1 = FooS1 Int deriving VS.Storable
59+
60+
newtype instance VU.MVector s FooS1 = MV_FooS1 (VS.MVector s FooS1)
61+
newtype instance VU.Vector FooS1 = V_FooS1 (VS.Vector FooS1)
62+
deriving via (VU.UnboxViaStorable FooS1) instance VGM.MVector VU.MVector FooS1
63+
deriving via (VU.UnboxViaStorable FooS1) instance VG.Vector VU.Vector FooS1
64+
instance VU.Unbox FooS1
65+
66+
67+
newtype FooS2 = FooS2 Int
68+
69+
newtype instance VU.MVector s FooS2 = MV_FooS2 (VS.MVector s Int)
70+
newtype instance VU.Vector FooS2 = V_FooS2 (VS.Vector Int)
71+
deriving via (VU.UnboxViaStorable Int) instance VGM.MVector VU.MVector FooS2
72+
deriving via (VU.UnboxViaStorable Int) instance VG.Vector VU.Vector FooS2
73+
instance VU.Unbox FooS2
74+
75+
76+
----------------------------------------------------------------
77+
-- Boxed variants
78+
79+
80+
data FooLazy a = FooLazy Int a
81+
deriving (Eq, Ord, Show)
82+
83+
instance VU.IsoUnbox (FooLazy a) (Int, VU.DoNotUnboxLazy a) where
84+
toURepr (FooLazy i a) = (i, VU.DoNotUnboxLazy a)
85+
fromURepr (i, VU.DoNotUnboxLazy a) = FooLazy i a
86+
{-# INLINE toURepr #-}
87+
{-# INLINE fromURepr #-}
88+
89+
newtype instance VU.MVector s (FooLazy a) = MV_FooLazy (VU.MVector s (Int, VU.DoNotUnboxLazy a))
90+
newtype instance VU.Vector (FooLazy a) = V_FooLazy (VU.Vector (Int, VU.DoNotUnboxLazy a))
91+
deriving via (FooLazy a `VU.As` (Int, VU.DoNotUnboxLazy a)) instance VGM.MVector VU.MVector (FooLazy a)
92+
deriving via (FooLazy a `VU.As` (Int, VU.DoNotUnboxLazy a)) instance VG.Vector VU.Vector (FooLazy a)
93+
instance VU.Unbox (FooLazy a)
94+
95+
96+
97+
data FooStrict a = FooStrict Int a
98+
deriving (Eq, Ord, Show)
99+
100+
instance VU.IsoUnbox (FooStrict a) (Int, VU.DoNotUnboxStrict a) where
101+
toURepr (FooStrict i a) = (i, VU.DoNotUnboxStrict a)
102+
fromURepr (i, VU.DoNotUnboxStrict a) = FooStrict i a
103+
{-# INLINE toURepr #-}
104+
{-# INLINE fromURepr #-}
105+
106+
newtype instance VU.MVector s (FooStrict a) = MV_FooStrict (VU.MVector s (Int, VU.DoNotUnboxStrict a))
107+
newtype instance VU.Vector (FooStrict a) = V_FooStrict (VU.Vector (Int, VU.DoNotUnboxStrict a))
108+
deriving via (FooStrict a `VU.As` (Int, VU.DoNotUnboxStrict a)) instance VGM.MVector VU.MVector (FooStrict a)
109+
deriving via (FooStrict a `VU.As` (Int, VU.DoNotUnboxStrict a)) instance VG.Vector VU.Vector (FooStrict a)
110+
instance VU.Unbox (FooStrict a)
111+
112+
113+
data FooNormalForm a = FooNormalForm Int a
114+
deriving (Eq, Ord, Show)
115+
116+
instance VU.IsoUnbox (FooNormalForm a) (Int, VU.DoNotUnboxNormalForm a) where
117+
toURepr (FooNormalForm i a) = (i, VU.DoNotUnboxNormalForm a)
118+
fromURepr (i, VU.DoNotUnboxNormalForm a) = FooNormalForm i a
119+
{-# INLINE toURepr #-}
120+
{-# INLINE fromURepr #-}
121+
122+
newtype instance VU.MVector s (FooNormalForm a) = MV_FooNormalForm (VU.MVector s (Int, VU.DoNotUnboxNormalForm a))
123+
newtype instance VU.Vector (FooNormalForm a) = V_FooNormalForm (VU.Vector (Int, VU.DoNotUnboxNormalForm a))
124+
deriving via (FooNormalForm a `VU.As` (Int, VU.DoNotUnboxNormalForm a))
125+
instance NFData a => VGM.MVector VU.MVector (FooNormalForm a)
126+
deriving via (FooNormalForm a `VU.As` (Int, VU.DoNotUnboxNormalForm a))
127+
instance NFData a => VG.Vector VU.Vector (FooNormalForm a)
128+
instance NFData a => VU.Unbox (FooNormalForm a)
129+
130+
131+
132+
----------------------------------------------------------------
133+
-- Unboxed
134+
135+
136+
data FooAs a = FooAs Int a
137+
deriving Show
138+
139+
instance VU.IsoUnbox (FooAs a) (Int,a) where
140+
toURepr (FooAs i a) = (i,a)
141+
fromURepr (i,a) = FooAs i a
142+
{-# INLINE toURepr #-}
143+
{-# INLINE fromURepr #-}
144+
145+
newtype instance VU.MVector s (FooAs a) = MV_FooAs (VU.MVector s (Int, a))
146+
newtype instance VU.Vector (FooAs a) = V_FooAs (VU.Vector (Int, a))
147+
deriving via (FooAs a `VU.As` (Int, a)) instance VU.Unbox a => VGM.MVector VU.MVector (FooAs a)
148+
deriving via (FooAs a `VU.As` (Int, a)) instance VU.Unbox a => VG.Vector VU.Vector (FooAs a)
149+
instance VU.Unbox a => VU.Unbox (FooAs a)
150+
151+
#endif

‎vector/vector.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -188,6 +188,7 @@ common tests-common
188188
, template-haskell
189189
, base-orphans >= 0.6
190190
, vector
191+
, deepseq
191192
, primitive
192193
, random
193194
, QuickCheck >= 2.9 && < 2.16
@@ -206,6 +207,7 @@ common tests-common
206207
Tests.Vector.Primitive
207208
Tests.Vector.Unboxed
208209
Tests.Vector.UnitTests
210+
Tests.Deriving
209211
Utilities
210212

211213
default-extensions:

0 commit comments

Comments
 (0)