diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for boring +## 0.1.1 + +- Add `GHC.Generics` instances +- Add `:~~:` and `Coercion` instances + ## 0.1 - `streams`, `constraints`, `generics-sop` instances. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/boring.cabal b/boring.cabal --- a/boring.cabal +++ b/boring.cabal @@ -1,61 +1,57 @@ -name: boring -version: 0.1 -synopsis: Boring and Absurd types +name: boring +version: 0.1.1 +synopsis: Boring and Absurd types description: * @Boring@ types are isomorphic to @()@. . * @Absurd@ types are isomorphic to @Void@. . See [What does () mean in Haskell -answer by Conor McBride](https://stackoverflow.com/questions/33112439/what-does-mean-in-haskell/33115522#33115522) -homepage: https://github.com/phadej/boring -bug-reports: https://github.com/phadej/boring/issues -license: BSD3 -license-file: LICENSE -author: Oleg Grenrus -maintainer: Oleg.Grenrus -copyright: (c) 2017 Oleg Grenrus -category: Data -build-type: Simple -extra-source-files: ChangeLog.md -cabal-version: >=1.10 + +homepage: https://github.com/phadej/boring +bug-reports: https://github.com/phadej/boring/issues +license: BSD3 +license-file: LICENSE +author: Oleg Grenrus +maintainer: Oleg.Grenrus +copyright: (c) 2017 Oleg Grenrus +category: Data +build-type: Simple +extra-source-files: ChangeLog.md +cabal-version: >=1.10 tested-with: - GHC==7.8.4, - GHC==7.10.3, - GHC==8.0.2, - GHC==8.2.2, - GHC==8.4.1 + GHC ==8.8.1 || ==8.6.5 || ==8.4.4 || ==8.2.2 || ==8.0.2 || ==7.10.3 || ==7.8.4 source-repository head - type: git - location: https://github.com/phadej/boring.git + type: git + location: https://github.com/phadej/boring.git library - exposed-modules: - Data.Boring + exposed-modules: Data.Boring build-depends: - base >=4.7 && <4.12, - base-compat >=0.9.3 && <0.11, - adjunctions >=4.4 && <4.5, - constraints ==0.4.1.3 || >=0.10 && <0.11, - fin >=0.0.1 && <0.1, - generics-sop >=0.3.2.0 && <0.4, - tagged >=0.8.5 && <0.9, - streams >=3.3 && <3.4, - transformers >=0.3 && <0.6, - transformers-compat >=0.5 && <0.7, - vec >=0.1 && <0.2 + adjunctions >=4.4 && <4.5 + , base >=4.7 && <4.13 + , base-compat >=0.10.5 && <0.11 + , constraints ==0.4.1.3 || >=0.10 && <0.11 + , fin >=0.0.1 && <0.1 + , generics-sop >=0.3.2.0 && <0.5 + , streams >=3.3 && <3.4 + , tagged >=0.8.6 && <0.9 + , transformers >=0.3 && <0.6 + , transformers-compat >=0.5 && <0.7 + , vec >=0.1 && <0.2 - if !impl(ghc >= 8.0) - build-depends: - semigroups >=0.18.4 && <0.19 - if !impl(ghc >= 7.10) - build-depends: - void >=0.7.2 && <0.8 + if !impl(ghc >=8.0) + build-depends: semigroups >=0.18.5 && <0.19 + if !impl(ghc >=7.10) + build-depends: void >=0.7.2 && <0.8 + other-extensions: CPP FlexibleContexts GADTs TypeOperators - hs-source-dirs: src - default-language: Haskell2010 + + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/Data/Boring.hs b/src/Data/Boring.hs --- a/src/Data/Boring.hs +++ b/src/Data/Boring.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeOperators #-} @@ -75,6 +76,7 @@ import Data.Proxy (Proxy (..)) import Data.Tagged (Tagged (..)) import Data.Stream.Infinite (Stream (..)) +import GHC.Generics hiding (Rep) import qualified Data.Fin as Fin import qualified Data.Nat as Nat @@ -84,6 +86,8 @@ import qualified Generics.SOP as SOP #if MIN_VERSION_base(4,7,0) +import qualified Data.Coerce as Co +import qualified Data.Type.Coercion as Co import qualified Data.Type.Equality as Eq #endif @@ -180,9 +184,19 @@ boring = Nothing #if MIN_VERSION_base(4,7,0) --- | Type equality is 'Boring' too. +-- | Coercibility is 'Boring' too. +instance Co.Coercible a b => Boring (Co.Coercion a b) where + boring = Co.Coercion + +-- | Homogeneous type equality is 'Boring' too. instance a ~ b => Boring (a Eq.:~: b) where boring = Eq.Refl + +# if MIN_VERSION_base(4,12,0) +-- | Heterogeneous type equality is 'Boring' too. +instance a Eq.~~ b => Boring (a Eq.:~~: b) where + boring = Eq.HRefl +# endif #endif instance n ~ 'Nat.Z => Boring (Vec.Vec n a) where @@ -194,6 +208,27 @@ instance n ~ ('Nat.S 'Nat.Z) => Boring (Fin.Fin n) where boring = Fin.boring +instance Boring (U1 p) where + boring = U1 + +instance Boring c => Boring (K1 i c p) where + boring = K1 boring + +instance Boring (f p) => Boring (M1 i c f p) where + boring = M1 boring + +instance (Boring (f p), Boring (g p)) => Boring ((f :*: g) p) where + boring = boring :*: boring + +instance Boring p => Boring (Par1 p) where + boring = Par1 boring + +instance Boring (f p) => Boring (Rec1 f p) where + boring = Rec1 boring + +instance Boring (f (g p)) => Boring ((f :.: g) p) where + boring = Comp1 boring + ------------------------------------------------------------------------------- -- Absurd ------------------------------------------------------------------------------- @@ -244,6 +279,28 @@ instance n ~ 'Nat.Z => Absurd (Fin.Fin n) where absurd = Fin.absurd + +instance Absurd (V1 p) where + absurd v = case v of {} + +instance Absurd c => Absurd (K1 i c p) where + absurd = absurd . unK1 + +instance Absurd (f p) => Absurd (M1 i c f p) where + absurd = absurd . unM1 + +instance (Absurd (f p), Absurd (g p)) => Absurd ((f :+: g) p) where + absurd (L1 a) = absurd a + absurd (R1 b) = absurd b + +instance Absurd p => Absurd (Par1 p) where + absurd = absurd . unPar1 + +instance Absurd (f p) => Absurd (Rec1 f p) where + absurd = absurd . unRec1 + +instance Absurd (f (g p)) => Absurd ((f :.: g) p) where + absurd = absurd . unComp1 ------------------------------------------------------------------------------- -- More interesting stuff