From ac47ca8c66becc79648e4fc119309640a97b5ba3 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 1 Sep 2021 11:52:31 +0530 Subject: [PATCH] Support ghc-4 to ghc-9 Commented out the test suite that depends on ghc-datasize package because that package is broken. --- package.yaml | 30 ++++++------ rawr.cabal | 45 +++++++----------- src/Data/Rawr.hs | 119 +++++++++++++++++++++++++++++++++++++++-------- 3 files changed, 132 insertions(+), 62 deletions(-) diff --git a/package.yaml b/package.yaml index 97ac3f9..a997972 100644 --- a/package.yaml +++ b/package.yaml @@ -29,15 +29,15 @@ github: pkmx/rawr ghc-options: -Wall dependencies: - - base == 4.9.* - - deepseq == 1.4.* + - base >= 4.11 && < 4.16 + - deepseq >= 1.4 && < 1.5 library: ghc-options: -funfolding-use-threshold=20 source-dirs: src exposed-modules: Data.Rawr dependencies: - - ghc-prim == 0.5.* + - ghc-prim >= 0.5 && < 0.8 tests: doctest: @@ -45,17 +45,17 @@ tests: source-dirs: - tests/doctest dependencies: - - doctest == 0.11.* - - lens == 4.14.* - datasize: - main: Main.hs - source-dirs: - - tests/datasize - dependencies: - - rawr - - ghc-datasize == 0.2.* - - tasty == 0.11.* - - tasty-hunit == 0.9.* + - doctest >= 0.11 && < 0.19 + - lens >= 4.14 && < 5.1 +# datasize: +# main: Main.hs +# source-dirs: +# - tests/datasize +# dependencies: +# - rawr +# - ghc-datasize == 0.2.* +# - tasty == 0.11.* +# - tasty-hunit == 0.9.* benchmarks: perf: @@ -64,7 +64,7 @@ benchmarks: - benchmarks/perf dependencies: - rawr - - criterion == 1.1.* + - criterion >= 1.1 && < 1.6 ghc-options: -funfolding-use-threshold=20 extra-source-files: diff --git a/rawr.cabal b/rawr.cabal index 15f6787..9bd4076 100644 --- a/rawr.cabal +++ b/rawr.cabal @@ -1,4 +1,6 @@ --- This file has been generated from package.yaml by hpack version 0.14.1. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack @@ -29,8 +31,6 @@ copyright: 2016 PkmX license: BSD3 license-file: LICENSE build-type: Simple -cabal-version: >= 1.10 - extra-source-files: README.md @@ -43,52 +43,41 @@ library src ghc-options: -Wall -funfolding-use-threshold=20 build-depends: - base == 4.9.* - , deepseq == 1.4.* - , ghc-prim == 0.5.* + base >=4.11 && <4.16 + , deepseq ==1.4.* + , ghc-prim >=0.5 && <0.8 exposed-modules: Data.Rawr other-modules: Paths_rawr default-language: Haskell2010 -test-suite datasize - type: exitcode-stdio-1.0 - main-is: Main.hs - hs-source-dirs: - tests/datasize - ghc-options: -Wall - build-depends: - base == 4.9.* - , deepseq == 1.4.* - , rawr - , ghc-datasize == 0.2.* - , tasty == 0.11.* - , tasty-hunit == 0.9.* - default-language: Haskell2010 - test-suite doctest type: exitcode-stdio-1.0 main-is: Main.hs + other-modules: + Paths_rawr hs-source-dirs: tests/doctest ghc-options: -Wall build-depends: - base == 4.9.* - , deepseq == 1.4.* - , doctest == 0.11.* - , lens == 4.14.* + base >=4.11 && <4.16 + , deepseq ==1.4.* + , doctest >=0.11 && <0.19 + , lens >=4.14 && <5.1 default-language: Haskell2010 benchmark perf type: exitcode-stdio-1.0 main-is: Main.hs + other-modules: + Paths_rawr hs-source-dirs: benchmarks/perf ghc-options: -Wall -funfolding-use-threshold=20 build-depends: - base == 4.9.* - , deepseq == 1.4.* + base >=4.11 && <4.16 + , criterion >=1.1 && <1.6 + , deepseq ==1.4.* , rawr - , criterion == 1.1.* default-language: Haskell2010 diff --git a/src/Data/Rawr.hs b/src/Data/Rawr.hs index 5bffa3a..dcfc7d9 100644 --- a/src/Data/Rawr.hs +++ b/src/Data/Rawr.hs @@ -326,11 +326,11 @@ data Strictness = Lazy | Strict -- data Field (s :: Strictness) (l :: Maybe Symbol) t = Field_ { unField :: t } deriving (Eq, Ord, Generic, NFData) -instance (Monoid t) => Monoid (Field 'Lazy l t) where +instance (Monoid t, (Semigroup (Field 'Lazy l t))) => Monoid (Field 'Lazy l t) where mempty = Field mempty Field x `mappend` Field y = Field (x `mappend` y) -instance (Monoid t) => Monoid (Field 'Strict l t) where +instance (Monoid t, (Semigroup (Field 'Strict l t))) => Monoid (Field 'Strict l t) where mempty = Field $! mempty Field x `mappend` Field y = Field $! (x `mappend` y) @@ -428,7 +428,7 @@ instance (Read t, Field s 'Nothing t :~ MkField t) => Read (Field s 'Nothing t) type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t instance l ~ l' => IsLabel (l :: Symbol) (Proxy l') where - fromLabel _ = Proxy + fromLabel = Proxy -- | @(:!!) s l a@ says that the record @s@ has a field of type @a@ at index @l@, and provides a @Lens s t a b@ to get/set that particular field. -- @@ -647,51 +647,132 @@ instance (NFData t0, NFData t1, NFData t2, NFData t3, NFData t4, NFData t5, NFDa {-# INLINE rnf #-} rnf (R8 a b c d e f g h) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e `seq` rnf f `seq` rnf g `seq` rnf h -instance Monoid (Rec '[]) where +instance (Semigroup (Rec '[])) => Monoid (Rec '[]) where mempty = R0 _ `mappend` _ = R0 -instance (Monoid (Field s0 l0 t0)) => Monoid (Rec '[Field s0 l0 t0]) where +instance (Monoid (Field s0 l0 t0), (Semigroup (Rec '[Field s0 l0 t0]))) => Monoid (Rec '[Field s0 l0 t0]) where mempty = R1 mempty R1 a `mappend` R1 a' = R1 (a `mappend` a') -instance (Monoid (Field s0 l0 t0), Monoid (Field s1 l1 t1)) => Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1]) where +instance (Monoid (Field s0 l0 t0), Monoid (Field s1 l1 t1), (Semigroup (Rec '[Field s0 l0 t0, Field s1 l1 t1]))) => Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1]) where mempty = R2 mempty mempty R2 a b `mappend` R2 a' b' = R2 (a `mappend` a') (b `mappend` b') -instance (Monoid (Field s0 l0 t0), Monoid (Field s1 l1 t1), Monoid (Field s2 l2 t2)) => Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2]) where +instance (Monoid (Field s0 l0 t0), Monoid (Field s1 l1 t1), Monoid (Field s2 l2 t2), (Semigroup (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2]))) => Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2]) where mempty = R3 mempty mempty mempty R3 a b c `mappend` R3 a' b' c' = R3 (a `mappend` a') (b `mappend` b') (c `mappend` c') -instance (Monoid (Field s0 l0 t0), Monoid (Field s1 l1 t1), Monoid (Field s2 l2 t2), Monoid (Field s3 l3 t3)) => Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2, Field s3 l3 t3]) where +instance (Monoid (Field s0 l0 t0), Monoid (Field s1 l1 t1), Monoid (Field s2 l2 t2), Monoid (Field s3 l3 t3), (Semigroup (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2, Field s3 l3 t3]))) => Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2, Field s3 l3 t3]) where mempty = R4 mempty mempty mempty mempty R4 a b c d `mappend` R4 a' b' c' d' = R4 (a `mappend` a') (b `mappend` b') (c `mappend` c') (d `mappend` d') -instance (Monoid (Field s0 l0 t0), Monoid (Field s1 l1 t1), Monoid (Field s2 l2 t2), Monoid (Field s3 l3 t3), Monoid (Field s4 l4 t4)) => Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2, Field s3 l3 t3, Field s4 l4 t4]) where +instance + ( Monoid (Field s0 l0 t0), + Monoid (Field s1 l1 t1), + Monoid (Field s2 l2 t2), + Monoid (Field s3 l3 t3), + Monoid (Field s4 l4 t4), + ( Semigroup + ( Rec + '[ Field s0 l0 t0, + Field s1 l1 t1, + Field s2 l2 t2, + Field s3 l3 t3, + Field s4 l4 t4 + ] + ) + ) + ) => + Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2, Field s3 l3 t3, Field s4 l4 t4]) + where mempty = R5 mempty mempty mempty mempty mempty R5 a b c d e `mappend` R5 a' b' c' d' e' = R5 (a `mappend` a') (b `mappend` b') (c `mappend` c') (d `mappend` d') (e `mappend` e') -instance (Monoid (Field s0 l0 t0), Monoid (Field s1 l1 t1), Monoid (Field s2 l2 t2), Monoid (Field s3 l3 t3), Monoid (Field s4 l4 t4), Monoid (Field s5 l5 t5)) => - Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2, Field s3 l3 t3, Field s4 l4 t4, Field s5 l5 t5]) where +instance + ( Monoid (Field s0 l0 t0), + Monoid (Field s1 l1 t1), + Monoid (Field s2 l2 t2), + Monoid (Field s3 l3 t3), + Monoid (Field s4 l4 t4), + Monoid (Field s5 l5 t5), + ( Semigroup + ( Rec + '[ Field s0 l0 t0, + Field s1 l1 t1, + Field s2 l2 t2, + Field s3 l3 t3, + Field s4 l4 t4, + Field s5 l5 t5 + ] + ) + ) + ) => + Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2, Field s3 l3 t3, Field s4 l4 t4, Field s5 l5 t5]) + where mempty = R6 mempty mempty mempty mempty mempty mempty R6 a b c d e f `mappend` R6 a' b' c' d' e' f' = R6 (a `mappend` a') (b `mappend` b') (c `mappend` c') (d `mappend` d') (e `mappend` e') (f `mappend` f') -instance (Monoid (Field s0 l0 t0), Monoid (Field s1 l1 t1), Monoid (Field s2 l2 t2), Monoid (Field s3 l3 t3), Monoid (Field s4 l4 t4), Monoid (Field s5 l5 t5), Monoid (Field s6 l6 t6)) => - Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2, Field s3 l3 t3, Field s4 l4 t4, Field s5 l5 t5, Field s6 l6 t6]) where +instance + ( Monoid (Field s0 l0 t0), + Monoid (Field s1 l1 t1), + Monoid (Field s2 l2 t2), + Monoid (Field s3 l3 t3), + Monoid (Field s4 l4 t4), + Monoid (Field s5 l5 t5), + Monoid (Field s6 l6 t6), + ( Semigroup + ( Rec + '[ Field s0 l0 t0, + Field s1 l1 t1, + Field s2 l2 t2, + Field s3 l3 t3, + Field s4 l4 t4, + Field s5 l5 t5, + Field s6 l6 t6 + ] + ) + ) + ) => + Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2, Field s3 l3 t3, Field s4 l4 t4, Field s5 l5 t5, Field s6 l6 t6]) + where mempty = R7 mempty mempty mempty mempty mempty mempty mempty R7 a b c d e f g `mappend` R7 a' b' c' d' e' f' g' = R7 (a `mappend` a') (b `mappend` b') (c `mappend` c') (d `mappend` d') (e `mappend` e') (f `mappend` f') (g `mappend` g') -instance (Monoid (Field s0 l0 t0), Monoid (Field s1 l1 t1), Monoid (Field s2 l2 t2), Monoid (Field s3 l3 t3), Monoid (Field s4 l4 t4), Monoid (Field s5 l5 t5), Monoid (Field s6 l6 t6), Monoid (Field s7 l7 t7)) => - Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2, Field s3 l3 t3, Field s4 l4 t4, Field s5 l5 t5, Field s6 l6 t6, Field s7 l7 t7]) where +instance + ( Monoid (Field s0 l0 t0), + Monoid (Field s1 l1 t1), + Monoid (Field s2 l2 t2), + Monoid (Field s3 l3 t3), + Monoid (Field s4 l4 t4), + Monoid (Field s5 l5 t5), + Monoid (Field s6 l6 t6), + Monoid (Field s7 l7 t7), + ( Semigroup + ( Rec + '[ Field s0 l0 t0, + Field s1 l1 t1, + Field s2 l2 t2, + Field s3 l3 t3, + Field s4 l4 t4, + Field s5 l5 t5, + Field s6 l6 t6, + Field s7 l7 t7 + ] + ) + ) + ) => + Monoid (Rec '[Field s0 l0 t0, Field s1 l1 t1, Field s2 l2 t2, Field s3 l3 t3, Field s4 l4 t4, Field s5 l5 t5, Field s6 l6 t6, Field s7 l7 t7]) + where mempty = R8 mempty mempty mempty mempty mempty mempty mempty mempty R8 a b c d e f g h `mappend` R8 a' b' c' d' e' f' g' h' = R8 (a `mappend` a') (b `mappend` b') (c `mappend` c') (d `mappend` d') (e `mappend` e') (f `mappend` f') (g `mappend` g') (h `mappend` h') -- Need s2fs ~ (s -> f s) for better type inference instance {-# OVERLAPPING #-} (a :~ s :!! l, Functor f, s2ft ~ (s -> f t), t :~ SetFieldImpl l b s) => IsLabel (l :: Symbol) ((a -> f b) -> s2ft) where - fromLabel _ = rlens @s @l @a @t @b + fromLabel = rlens @s @l @a @t @b instance {-# OVERLAPPING #-} (a :~ Rec xs :!! l) => IsLabel (l :: Symbol) (Rec xs -> a) where - fromLabel _ = get @(Rec xs) @l @a + fromLabel = get @(Rec xs) @l @a type family ToField (a :: *) = (r :: *) where ToField (Field s l t) = Field s l t @@ -1392,13 +1473,13 @@ infix 1 ::*: -- >>> case R ( #a := True, #b := (1 :: Int) ) of R ( _ :: "a" := Int ) :*: _ -> () -- -- ... error: --- ... Couldn't match type ‘Int’ with ‘Bool’ arising from a pattern +-- ... Couldn't match type ‘Bool’ with ‘Int’ -- ... -- -- >>> case R ( True, 1 :: Int ) of R ( a :: Int ) :*: _ -> () -- -- ... error: --- ... Couldn't match type ‘Int’ with ‘Bool’ arising from a pattern +-- ... Couldn't match type ‘Bool’ with ‘Int’ arising from a pattern -- ... pattern (:*:) :: forall xs ys r. (r :~ xs ::*: ys) => xs -> ys -> r