diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index dfb3318..1c7360d 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.13.20211030 +# version: 0.15.20220609 # -# REGENDATA ("0.13.20211030",["github","cabal.project"]) +# REGENDATA ("0.15.20220609",["github","cabal.project"]) # name: Haskell-CI on: @@ -23,16 +23,23 @@ on: jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} - runs-on: ubuntu-18.04 + runs-on: ubuntu-20.04 + timeout-minutes: + 60 container: image: buildpack-deps:bionic continue-on-error: ${{ matrix.allow-failure }} strategy: matrix: include: - - compiler: ghc-9.2.1 + - compiler: ghc-9.4.0.20220523 compilerKind: ghc - compilerVersion: 9.2.1 + compilerVersion: 9.4.0.20220523 + setup-method: ghcup + allow-failure: true + - compiler: ghc-9.2.3 + compilerKind: ghc + compilerVersion: 9.2.3 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.1 @@ -108,18 +115,19 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" - "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 + if $HEADHACKAGE; then "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; fi + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) else apt-add-repository -y 'ppa:hvr/ghc' apt-get update apt-get install -y "$HCNAME" mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 + "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) fi env: HCKIND: ${{ matrix.compilerKind }} @@ -150,7 +158,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -179,6 +187,22 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-docspec.xz + echo 'e224700d9e8c9ec7ec6bc3f542ba433cd9925a5d356676c62a9bd1f2c8be8f8a cabal-docspec.xz' | sha256sum -c - + xz -d < cabal-docspec.xz > $HOME/.cabal/bin/cabal-docspec + rm -f cabal-docspec.xz + chmod a+x $HOME/.cabal/bin/cabal-docspec + cabal-docspec --version - name: checkout uses: actions/checkout@v2 with: @@ -226,6 +259,9 @@ jobs: if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <> cabal.project + fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(some)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local @@ -252,13 +288,17 @@ jobs: - name: tests run: | $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct + - name: docspec + run: | + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all ; fi + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then cabal-docspec $ARG_COMPILER ; fi - name: cabal check run: | cd ${PKGDIR_some} || false ${CABAL} -vnormal check - name: haddock run: | - $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all + $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all - name: unconstrained build run: | rm -f cabal.project.local diff --git a/ChangeLog.md b/ChangeLog.md index f92e90b..33f166f 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,10 @@ +# 1.0.4 + +- Add instances for `(:~~:)` +- Add instances for `:+:` and `:*:` +- Add `defaultGeq :: GCompare f => f a -> f b -> Maybe (a :~: b)` +- Add `defaultGshowsPrec :: Show (t a) => Int -> t a -> ShowS` + # 1.0.3 - Make `GNFData` PolyKinded. diff --git a/cabal.haskell-ci b/cabal.haskell-ci index e82dfd8..1fa88de 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -1,4 +1,5 @@ branches : master +docspec: >=8.2 constraint-set safe constraints: some -newtype-unsafe diff --git a/some.cabal b/some.cabal index 3082734..cedfedb 100644 --- a/some.cabal +++ b/some.cabal @@ -1,7 +1,5 @@ name: some -version: 1.0.3 -x-revision: 2 -stability: provisional +version: 1.0.4 cabal-version: >=1.10 build-type: Simple author: @@ -39,7 +37,8 @@ tested-with: || ==8.8.4 || ==8.10.4 || ==9.0.1 - || ==9.2.1 + || ==9.2.3 + || ==9.4.1 extra-source-files: ChangeLog.md @@ -77,7 +76,7 @@ library base >=4.3 && <4.17 , deepseq >=1.3.0.0 && <1.5 - if !impl(ghc >=7.8) + if !impl(ghc >=8.2) build-depends: type-equality >=1 && <1.1 if !impl(ghc >=8.0) diff --git a/src/Data/GADT/Compare.hs b/src/Data/GADT/Compare.hs index e3f2945..5ebb21e 100644 --- a/src/Data/GADT/Compare.hs +++ b/src/Data/GADT/Compare.hs @@ -7,6 +7,7 @@ module Data.GADT.Compare ( -- * Equality GEq (..), + defaultGeq, defaultEq, defaultNeq, -- * Total order comparison diff --git a/src/Data/GADT/DeepSeq.hs b/src/Data/GADT/DeepSeq.hs index 0046985..02ea166 100644 --- a/src/Data/GADT/DeepSeq.hs +++ b/src/Data/GADT/DeepSeq.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif @@ -19,6 +20,18 @@ import Data.Functor.Product (Product (..)) import Data.Functor.Sum (Sum (..)) import Data.Type.Equality ((:~:) (..)) +#if MIN_VERSION_base(4,6,0) +import GHC.Generics ((:+:) (..), (:*:) (..)) +#endif + +#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) +import Data.Type.Equality ((:~~:) (..)) +#else +import Data.Type.Equality.Hetero ((:~~:) (..)) +#endif +#endif + #if MIN_VERSION_base(4,10,0) import qualified Type.Reflection as TR #endif @@ -41,10 +54,25 @@ instance (GNFData a, GNFData b) => GNFData (Sum a b) where grnf (InL x) = grnf x grnf (InR y) = grnf y +#if MIN_VERSION_base(4,6,0) +instance (GNFData a, GNFData b) => GNFData (a :*: b) where + grnf (a :*: b) = grnf a `seq` grnf b + +instance (GNFData a, GNFData b) => GNFData (a :+: b) where + grnf (L1 x) = grnf x + grnf (R1 y) = grnf y +#endif + -- | @since 1.0.3 instance GNFData ((:~:) a) where grnf Refl = () +#if MIN_VERSION_base(4,9,0) +-- | @since 1.0.4 +instance GNFData ((:~~:) a) where + grnf HRefl = () +#endif + #if MIN_VERSION_base(4,10,0) -- | @since 1.0.3 instance GNFData TR.TypeRep where diff --git a/src/Data/GADT/Internal.hs b/src/Data/GADT/Internal.hs index 2743d44..9ba644f 100644 --- a/src/Data/GADT/Internal.hs +++ b/src/Data/GADT/Internal.hs @@ -13,8 +13,11 @@ #if __GLASGOW_HASKELL__ >= 810 {-# LANGUAGE StandaloneKindSignatures #-} #endif +#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 805 +{-# LANGUAGE TypeInType #-} +#endif #if (__GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 707) || __GLASGOW_HASKELL__ >= 801 -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif @@ -27,34 +30,59 @@ import Data.Maybe (isJust, isNothing) import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..)) import Data.Type.Equality ((:~:) (..)) +#if MIN_VERSION_base(4,6,0) +import GHC.Generics ((:+:) (..), (:*:) (..)) +#endif #if __GLASGOW_HASKELL__ >=708 import Data.Typeable (Typeable) #endif +#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) +import Data.Type.Equality ((:~~:) (..)) +#else +import Data.Type.Equality.Hetero ((:~~:) (..)) +#endif +#endif + #if MIN_VERSION_base(4,10,0) import Data.Type.Equality (testEquality) import qualified Type.Reflection as TR #endif +#if __GLASGOW_HASKELL__ >= 800 +import Data.Kind (Type) +#endif + #if __GLASGOW_HASKELL__ >= 810 -import Data.Kind (Type, Constraint) +import Data.Kind (Constraint) #endif -- $setup --- >>> :set -XKindSignatures -XGADTs +-- >>> :set -XKindSignatures -XGADTs -XTypeOperators +-- >>> import Data.Type.Equality +-- >>> import Data.Functor.Sum +-- >>> import GHC.Generics -- |'Show'-like class for 1-type-parameter GADTs. @GShow t => ...@ is equivalent to something -- like @(forall a. Show (t a)) => ...@. The easiest way to create instances would probably be -- to write (or derive) an @instance Show (T a)@, and then simply say: -- --- > instance GShow t where gshowsPrec = showsPrec +-- > instance GShow t where gshowsPrec = defaultGshowsPrec #if __GLASGOW_HASKELL__ >= 810 type GShow :: (k -> Type) -> Constraint #endif class GShow t where gshowsPrec :: Int -> t a -> ShowS +-- |If 'f' has a 'Show (f a)' instance, this function makes a suitable default +-- implementation of 'gshowsPrec'. +-- +-- @since 1.0.4 +defaultGshowsPrec :: Show (t a) => Int -> t a -> ShowS +defaultGshowsPrec = showsPrec + gshows :: GShow t => t a -> ShowS gshows = gshowsPrec (-1) @@ -64,6 +92,12 @@ gshow x = gshows x "" instance GShow ((:~:) a) where gshowsPrec _ Refl = showString "Refl" +#if MIN_VERSION_base(4,9,0) +-- | @since 1.0.4 +instance GShow ((:~~:) a) where + gshowsPrec _ HRefl = showString "HRefl" +#endif + #if MIN_VERSION_base(4,10,0) instance GShow TR.TypeRep where gshowsPrec = showsPrec @@ -86,6 +120,28 @@ instance (GShow a, GShow b) => GShow (Product a b) where . showChar ' ' . gshowsPrec 11 y +#if MIN_VERSION_base(4,6,0) +-- +-- | >>> gshow (L1 Refl :: ((:~:) Int :+: (:~:) Bool) Int) +-- "L1 Refl" +-- +-- @since 1.0.4 +instance (GShow a, GShow b) => GShow (a :+: b) where + gshowsPrec d = \s -> case s of + L1 x -> showParen (d > 10) (showString "L1 " . gshowsPrec 11 x) + R1 x -> showParen (d > 10) (showString "R1 " . gshowsPrec 11 x) + +-- | >>> gshow (Pair Refl Refl :: Product ((:~:) Int) ((:~:) Int) Int) +-- "Refl :*: Refl" +-- +-- @since 1.0.4 +instance (GShow a, GShow b) => GShow (a :*: b) where + gshowsPrec d (x :*: y) = showParen (d > 6) + $ gshowsPrec 6 x + . showString " :*: " + . gshowsPrec 6 y +#endif + -- |@GReadS t@ is equivalent to @ReadS (forall b. (forall a. t a -> b) -> b)@, which is -- in turn equivalent to @ReadS (Exists t)@ (with @data Exists t where Exists :: t a -> Exists t@) #if __GLASGOW_HASKELL__ >= 810 @@ -121,6 +177,9 @@ gread s g = withSome (hd [f | (f, "") <- greads s]) g where -- >>> greadMaybe "InL Refl" mkSome :: Maybe (Some (Sum ((:~:) Int) ((:~:) Bool))) -- Just (mkSome (InL Refl)) -- +-- >>> greadMaybe "L1 Refl" mkSome :: Maybe (Some ((:~:) Int :+: (:~:) Bool)) +-- Just (mkSome (L1 Refl)) +-- -- >>> greadMaybe "garbage" mkSome :: Maybe (Some ((:~:) Int)) -- Nothing -- @@ -130,10 +189,19 @@ greadMaybe s g = case [f | (f, "") <- greads s] of _ -> Nothing instance GRead ((:~:) a) where - greadsPrec p s = readsPrec p s >>= f - where - f :: forall x. (x :~: x, String) -> [(Some ((:~:) x), String)] - f (Refl, rest) = return (mkSome Refl, rest) + greadsPrec _ = readParen False (\s -> + [ (S $ \k -> k (Refl :: a :~: a), t) + | ("Refl", t) <- lex s + ]) + +#if MIN_VERSION_base(4,9,0) +-- | @since 1.0.4 +instance k1 ~ k2 => GRead ((:~~:) (a :: k1) :: k2 -> Type) where + greadsPrec _ = readParen False (\s -> + [ (S $ \k -> k (HRefl :: a :~~: a), t) + | ("HRefl", t) <- lex s + ]) +#endif instance (GRead a, GRead b) => GRead (Sum a b) where greadsPrec d s = @@ -147,6 +215,21 @@ instance (GRead a, GRead b) => GRead (Sum a b) where | ("InR", s2) <- lex s1 , (r, t) <- greadsPrec 11 s2 ]) s +#if MIN_VERSION_base(4,6,0) +-- | @since 1.0.4 +instance (GRead a, GRead b) => GRead (a :+: b) where + greadsPrec d s = + readParen (d > 10) + (\s1 -> [ (S $ \k -> withSome r (k . L1), t) + | ("L1", s2) <- lex s1 + , (r, t) <- greadsPrec 11 s2 ]) s + ++ + readParen (d > 10) + (\s1 -> [ (S $ \k -> withSome r (k . R1), t) + | ("R1", s2) <- lex s1 + , (r, t) <- greadsPrec 11 s2 ]) s +#endif + ------------------------------------------------------------------------------- -- GEq ------------------------------------------------------------------------------- @@ -175,6 +258,15 @@ class GEq f where -- (Making use of the 'DSum' type from in both examples) geq :: f a -> f b -> Maybe (a :~: b) +-- |If 'f' has a 'GCompare' instance, this function makes a suitable default +-- implementation of 'geq'. +-- +-- @since 1.0.4 +defaultGeq :: GCompare f => f a -> f b -> Maybe (a :~: b) +defaultGeq a b = case gcompare a b of + GEQ -> Just Refl + _ -> Nothing + -- |If 'f' has a 'GEq' instance, this function makes a suitable default -- implementation of '(==)'. defaultEq :: GEq f => f a -> f b -> Bool @@ -188,6 +280,12 @@ defaultNeq x y = isNothing (geq x y) instance GEq ((:~:) a) where geq (Refl :: a :~: b) (Refl :: a :~: c) = Just (Refl :: b :~: c) +#if MIN_VERSION_base(4,9,0) +-- | @since 1.0.4 +instance GEq ((:~~:) a) where + geq (HRefl :: a :~~: b) (HRefl :: a :~~: c) = Just (Refl :: b :~: c) +#endif + instance (GEq a, GEq b) => GEq (Sum a b) where geq (InL x) (InL y) = geq x y geq (InR x) (InR y) = geq x y @@ -199,6 +297,21 @@ instance (GEq a, GEq b) => GEq (Product a b) where Refl <- geq y y' return Refl +#if MIN_VERSION_base(4,6,0) +-- | @since 1.0.4 +instance (GEq f, GEq g) => GEq (f :+: g) where + geq (L1 x) (L1 y) = geq x y + geq (R1 x) (R1 y) = geq x y + geq _ _ = Nothing + +-- | @since 1.0.4 +instance (GEq a, GEq b) => GEq (a :*: b) where + geq (x :*: y) (x' :*: y') = do + Refl <- geq x x' + Refl <- geq y y' + return Refl +#endif + #if MIN_VERSION_base(4,10,0) instance GEq TR.TypeRep where geq = testEquality @@ -289,6 +402,12 @@ class GEq f => GCompare f where instance GCompare ((:~:) a) where gcompare Refl Refl = GEQ +#if MIN_VERSION_base(4,9,0) +-- | @since 1.0.4 +instance GCompare ((:~~:) a) where + gcompare HRefl HRefl = GEQ +#endif + #if MIN_VERSION_base(4,10,0) instance GCompare TR.TypeRep where gcompare t1 t2 = @@ -321,6 +440,25 @@ instance (GCompare a, GCompare b) => GCompare (Product a b) where GEQ -> GEQ GGT -> GGT +#if MIN_VERSION_base(4,6,0) +-- | @since 1.0.4 +instance (GCompare f, GCompare g) => GCompare (f :+: g) where + gcompare (L1 x) (L1 y) = gcompare x y + gcompare (L1 _) (R1 _) = GLT + gcompare (R1 _) (L1 _) = GGT + gcompare (R1 x) (R1 y) = gcompare x y + +-- | @since 1.0.4 +instance (GCompare a, GCompare b) => GCompare (a :*: b) where + gcompare (x :*: y) (x' :*: y') = case gcompare x x' of + GLT -> GLT + GGT -> GGT + GEQ -> case gcompare y y' of + GLT -> GLT + GEQ -> GEQ + GGT -> GGT +#endif + ------------------------------------------------------------------------------- -- Some ------------------------------------------------------------------------------- diff --git a/src/Data/GADT/Show.hs b/src/Data/GADT/Show.hs index b9fa0ce..52b3008 100644 --- a/src/Data/GADT/Show.hs +++ b/src/Data/GADT/Show.hs @@ -7,6 +7,7 @@ module Data.GADT.Show ( -- * Showing GShow (..), + defaultGshowsPrec, gshows, gshow, -- * Reading diff --git a/src/Data/Some/GADT.hs b/src/Data/Some/GADT.hs index 4647b3c..a77925e 100644 --- a/src/Data/Some/GADT.hs +++ b/src/Data/Some/GADT.hs @@ -41,6 +41,7 @@ import Data.GADT.Show -- $setup -- >>> :set -XKindSignatures -XGADTs +-- >>> import Data.GADT.Show -- | Existential. This is type is useful to hide GADTs' parameters. -- diff --git a/src/Data/Some/Newtype.hs b/src/Data/Some/Newtype.hs index 4ed5c72..4411317 100644 --- a/src/Data/Some/Newtype.hs +++ b/src/Data/Some/Newtype.hs @@ -47,6 +47,7 @@ import Data.GADT.Show -- $setup -- >>> :set -XKindSignatures -XGADTs +-- >>> import Data.GADT.Show -- | Existential. This is type is useful to hide GADTs' parameters. --