generic-type-asserts (empty) → 0.3.0

raw patch · 7 files changed

+244/−0 lines, 7 filesdep +basedep +generic-type-assertsdep +type-spec

Dependencies added: base, generic-type-asserts, type-spec

Files

CHANGELOG.md +13/−0
LICENSE +20/−0
README.md +19/−0
generic-type-asserts.cabal +74/−0
src/Generic/Type/Assert.hs +61/−0
src/Generic/Type/Assert/Error.hs +30/−0
test/Main.hs +27/−0

+ CHANGELOG.md view

@@ -0,0 +1,13 @@+## 0.3.0 (2024-04-10)+Rename package from `generic-data-asserts` to `generic-type-asserts`. This+package only does type-level work, so it's more appropriate.++  * don't expose util type families++## 0.2.0 (2024-04-05)+* split errors out into own module++## 0.1.1 (2024-04-04)+Initial release.++  * extracted from generic-data-functions

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2024 Ben Orchard (@raehik) <thefirstmuffinman@gmail.com>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ README.md view

@@ -0,0 +1,19 @@+[gdf-hackage]: https://hackage.haskell.org/package/generic-data-functions++# generic-data-asserts+Structural assertions on the generic data representations (`GHC.Generic.Rep a`).++Sometimes, we want to write generics that only work on certain data types with a+certain shape e.g. non-sum types (single constructor). Achieving this is fairly+straightforward if we add a `TypeError` constraint on the relevant generic+representation unwrapping instance (here, the `(:+:)` constructor sum type).++This library effectively pulls those checks out of generic code and runs them by+separately. This way, we can simplify our generics, and make them more flexible+(e.g. a user may choose whether to permit void types at compile time or not).++This began as a minor feature in my [generic-data-functions][gdf-hackage]+library.++## License+Provided under the MIT license. See `LICENSE` for license text.

+ generic-type-asserts.cabal view

@@ -0,0 +1,74 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name:           generic-type-asserts+version:        0.3.0+synopsis:       Structural assertions on generic type representations.+description:    Please see README.md.+category:       Data, Generics, Type+homepage:       https://github.com/raehik/generic-type-asserts#readme+bug-reports:    https://github.com/raehik/generic-type-asserts/issues+author:         Ben Orchard+maintainer:     Ben Orchard <thefirstmuffinman@gmail.com>+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/raehik/generic-type-asserts++library+  exposed-modules:+      Generic.Type.Assert+      Generic.Type.Assert.Error+  other-modules:+      Paths_generic_type_asserts+  hs-source-dirs:+      src+  default-extensions:+      LambdaCase+      NoStarIsType+      DerivingVia+      DeriveAnyClass+      GADTs+      RoleAnnotations+      DefaultSignatures+      TypeFamilies+      DataKinds+      MagicHash+  ghc-options: -Wall+  build-depends:+      base >=4.14 && <5+  default-language: GHC2021++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Paths_generic_type_asserts+  hs-source-dirs:+      test+  default-extensions:+      LambdaCase+      NoStarIsType+      DerivingVia+      DeriveAnyClass+      GADTs+      RoleAnnotations+      DefaultSignatures+      TypeFamilies+      DataKinds+      MagicHash+  ghc-options: -Wall+  build-depends:+      base >=4.14 && <5+    , generic-type-asserts+    , type-spec >=0.4.0.0 && <0.5+  default-language: GHC2021

+ src/Generic/Type/Assert.hs view

@@ -0,0 +1,61 @@+{-# LANGUAGE UndecidableInstances #-} -- for IsEnum++-- | Structural assertions on generic type representation.++module Generic.Type.Assert+  ( type GAssertNotVoid+  , type GAssertNotSum, type GAssertSum+  , type GAssertEnum+  ) where++import GHC.Generics+import Generic.Type.Assert.Error+import GHC.TypeError ( Assert )++-- | Type is not void i.e. has at least one constructor.+type GAssertNotVoid a =+    Assert (IsNotVoid (StripD1 (Rep a))) (GAssertErrorVoid a)+type family IsNotVoid a where+    IsNotVoid V1  = False+    IsNotVoid _ = True++-- | Type is not a sum type i.e. has at most one constructor.+--+-- Permits void types.+type GAssertNotSum a =+    Assert (IsNotSum (StripD1 (Rep a))) (GAssertErrorSum a)+type family IsNotSum a where+    IsNotSum (_ :+: _) = False+    IsNotSum _ = True++-- | Type is a sum type i.e. has >=2 constructors.+--+-- Permits void types.+type GAssertSum a =+    Assert (IsSum (StripD1 (Rep a))) (GAssertErrorNotSum a)+type family IsSum a where+    IsSum (C1 _ _) = False+    IsSum _ = True++-- | Type has only empty constructors.+--+-- Permits void types.+type GAssertEnum a =+    Assert (IsEnum (StripD1 (Rep a))) (GAssertErrorNotEnum a)+type family IsEnum a where+    IsEnum V1 = True+    IsEnum (C1 _ a) = ConsIsEmpty a+    IsEnum (l :+: r) = IsEnum l `And` IsEnum r++--------------------------------------------------------------------------------++type family StripD1 a where StripD1 (D1 _ a) = a++type family ConsIsEmpty a where+    ConsIsEmpty U1 = True+    ConsIsEmpty _  = False++-- | Type level boolean AND.+type family And l r where+    And True True = True+    And _    _    = False

+ src/Generic/Type/Assert/Error.hs view

@@ -0,0 +1,30 @@+-- | Descriptive type errors for generic representation assertion failures.+--+-- These are potentially useful separately from the asserts, in places where+-- we're unable to perform asserts which evaluate to 'Constraint's e.g. type+-- families, so we expose them neatly here.++module Generic.Type.Assert.Error where++import GHC.TypeError+import GHC.TypeLits ( type Symbol )++-- polymorphic kind keeps us extra useful -- we only use as 'Constraint', but+-- library users may want to use this in type families+type GAssertError :: ka -> Symbol -> k+type GAssertError a msg = TypeError+         ('Text "Assertion on generic representation failed for type: "+    :<>: 'ShowType a+    :$$: 'Text "Message: " :<>: 'Text msg)++type GAssertErrorVoid a =+    GAssertError a "not non-void type (>=1 constructor)"++type GAssertErrorSum a =+    GAssertError a "not non-sum type (1 constructor)"++type GAssertErrorNotSum a =+    GAssertError a "not sum type (>=2 constructors)"++type GAssertErrorNotEnum a =+    GAssertError a "not enum type (all empty constructors)"

+ test/Main.hs view

@@ -0,0 +1,27 @@+module Main where++import Test.TypeSpec+import GHC.Generics+import Generic.Type.Assert+import Data.Kind++data DSum = DSum1 () | DSum2 deriving stock Generic+data DEnum = DEnum1 | DEnum2 | DEnum3 deriving stock Generic+data DNonSum = DNonSum () () deriving stock Generic+data DVoid deriving stock Generic++main :: IO ()+main = print spec++spec+    :: Expect '[ AssertPasses (GAssertNotVoid DSum)+               , AssertPasses (GAssertSum DSum)+               , AssertPasses (GAssertNotSum DNonSum)+               , AssertPasses (GAssertEnum DEnum)+               ]+spec = Valid++type AssertPasses a = Is a (() :: Constraint)++-- can't write this because GHC finds the TypeError before type-spec+--type AssertFails a = Isn't a (() :: Constraint)