generic-override 0.0.0.0 → 0.2.0.0

raw patch · 9 files changed

+237/−34 lines, 9 filesdep +generic-overridedep +hspecsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: generic-override, hspec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• ChangeLog.md +0/−3
• README.md +10/−1
• Setup.hs +0/−2
• generic-override.cabal +34/−19
• src/Data/Override.hs +8/−8
• src/Data/Override/Instances.hs +88/−0
• src/Data/Override/Internal.hs +15/−1
• test/Test.hs +72/−0

@@ -0,0 +1,10 @@+# Changelog for generic-override++## 0.1.0.0++* Instances for Eq, Ord, Semigroup, Monoid+* Added With combinator++## 0.0.0.0++* Initial release

@@ -1,3 +0,0 @@-# Changelog for scoped-instances--## Unreleased changes

@@ -1,10 +1,19 @@ # generic-override +[![Hackage](https://img.shields.io/hackage/v/generic-override.svg?logo=haskell&color=blueviolet)](https://hackage.haskell.org/package/generic-override)+[![Build](https://img.shields.io/travis/estatico/generic-override.svg?logo=travis)](http://travis-ci.org/estatico/generic-override)+ For the associated blog post describing how this works, see [Overriding Type Class Instances](http://caryrobbins.com/dev/overriding-type-class-instances-2/).  ------------------------- +This repo contains the following libraries -+* [generic-override](https://hackage.haskell.org/package/generic-override)+* [generic-override-aeson](https://hackage.haskell.org/package/generic-override-aeson)++-------------------------+ This library provides the ability to override instances used by generic derivation.  ## Example@@ -63,4 +72,4 @@ ```  For more examples, see the test suite in-[generic-override-aeson](./aeson/test/Test.hs).+[generic-override-aeson](https://github.com/estatico/generic-override/blob/master/generic-override-aeson/test/Test.hs).

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,33 +1,48 @@-cabal-version: 1.12-name: generic-override-version: 0.0.0.0-license: BSD3-license-file: LICENSE-copyright: 2020 Estatico Studios LLC-maintainer: carymrobbins@gmail.com-author: Cary Robbins-homepage: https://github.com/estatico/generic-override#readme-bug-reports: https://github.com/estatico/generic-override/issues-synopsis: Provides functionality for overriding instances for generic derivation+cabal-version:      1.12+name:               generic-override+version:            0.2.0.0+license:            BSD3+license-file:       LICENSE+copyright:          2020 Estatico Studios LLC+maintainer:         carymrobbins@gmail.com+author:             Cary Robbins+homepage:           https://github.com/estatico/generic-override#readme+bug-reports:        https://github.com/estatico/generic-override/issues+synopsis:+    Provides functionality for overriding instances for generic derivation+ description:     Please see the README on GitHub at <https://github.com/estatico/generic-override#readme>-category: Generics-build-type: Simple++category:           Generics+build-type:         Simple extra-source-files:     README.md-    ChangeLog.md+    CHANGELOG.md  source-repository head-    type: git+    type:     git     location: https://github.com/estatico/generic-override  library     exposed-modules:         Data.Override+        Data.Override.Instances         Data.Override.Internal-    hs-source-dirs: src-    other-modules:-        Paths_generic_override++    hs-source-dirs:   src+    other-modules:    Paths_generic_override     default-language: Haskell2010+    build-depends:    base >=4.7 && <5++test-suite generic-override-test+    type:             exitcode-stdio-1.0+    main-is:          Test.hs+    hs-source-dirs:   test+    other-modules:    Paths_generic_override+    default-language: Haskell2010+    ghc-options:      -threaded -rtsopts -with-rtsopts=-N     build-depends:-        base >=4.7 && <5+        base >=4.7 && <5,+        generic-override -any,+        hspec >=2.7.1 && <2.8

@@ -1,9 +1,9 @@-module Data.Override (module X) where--import Data.Override.Internal as X-  ( Override(Override), unOverride-  , Overridden(Overridden), unOverridden+-- | The public, stable generic-override API.+module Data.Override+  ( Override(Override)   , As-  , Using-  , override-  )+  , With+  ) where++import Data.Override.Internal (Override(Override), As, With)+import Data.Override.Instances ()

@@ -0,0 +1,88 @@+-- | Instances for some classes from @base@.+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Override.Instances where++import Data.Coerce (Coercible, coerce)+import Data.Function (on)+import GHC.Generics (Generic(Rep, from, to))++import Data.Override.Internal++-- The @foo `on` from'@ idiom is taken from @generic-data@ by Li-yao Xia.+from' :: Generic a => a -> Rep a ()+from' = from++to' :: Generic a => Rep a () -> a+to' = to++-- Eq++instance+  ( Generic (Override a xs)+  , Eq (Rep (Override a xs) ())+  ) => Eq (Override a xs)+  where+  (==) = (==) `on` from'++instance+  ( Coercible a (Using ms a xs)+  , Eq (Using ms a xs)+  ) => Eq (Overridden ms a xs)+  where+  x == y = (==) @(Using ms a xs) (coerce x) (coerce y)++-- Ord++instance+  ( Generic (Override a xs)+  , Ord (Rep (Override a xs) ())+  ) => Ord (Override a xs)+  where+  compare = compare `on` from'++instance+  ( Coercible a (Using ms a xs)+  , Ord (Using ms a xs)+  ) => Ord (Overridden ms a xs)+  where+  compare x y = compare @(Using ms a xs) (coerce x) (coerce y)+++-- Semigroup++instance+  ( Generic (Override a xs)+  , Semigroup (Rep (Override a xs) ())+  ) => Semigroup (Override a xs)+  where+  x <> y = to (from' x <> from' y)++instance+  ( Coercible a (Using ms a xs)+  , Semigroup (Using ms a xs)+  ) => Semigroup (Overridden ms a xs)+  where+  x <> y = coerce $ (<>) @(Using ms a xs) (coerce x) (coerce y)++-- Monoid++instance+  ( Generic (Override a xs)+  , Monoid (Rep (Override a xs) ())+  ) => Monoid (Override a xs)+  where+  mempty = to' mempty+  x `mappend` y = to (from' x `mappend` from' y)++instance+  ( Coercible a (Using ms a xs)+  , Monoid (Using ms a xs)+  ) => Monoid (Overridden ms a xs)+  where+  mempty = coerce $ mempty @(Using ms a xs)+  x `mappend` y = coerce $ mappend @(Using ms a xs) (coerce x) (coerce y)

@@ -1,3 +1,9 @@+-- | This is the internal generic-override API and should be considered+-- unstable and subject to change. This module is exposed for library integrators+-- (e.g. generic-override-aeson). In general, unless you are integrating+-- some type class with generic-override, you should prefer to use the+-- public, stable API provided by 'Data.Override'.+ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-}@@ -22,7 +28,6 @@ -- Apply it to a type 'a' and supply a type-level list of instance -- overrides 'xs'. newtype Override a (xs :: [*]) = Override a-  deriving stock (Show, Eq)  -- | Unwrap an 'Override' value. unOverride :: Override a xs -> a@@ -37,6 +42,9 @@ -- (kind 'Symbol'). data As (o :: k) n +-- | Used to wrap a field into a something of kind @* -> *@, for example another newtype.+data With (o :: k) (w :: * -> *)+ -- | Used at the leaf nodes of a generic 'Rep' newtype Overridden (ms :: Maybe Symbol) a (xs :: [*]) = Overridden a @@ -95,6 +103,12 @@   Using ms x (As (o :: Symbol) n ': xs) =     If (ms == 'Just o) n (Using ms x xs) +  Using ms x (With (o :: Symbol) w ': xs) =+    If (ms == 'Just o) (w x) (Using ms x xs)+   -- Override the matching type.   Using ms x (As (o :: *) n ': xs) =     If (x == o) n (Using ms x xs)++  Using ms x (With (o :: *) w ': xs) =+    If (x == o) (w x) (Using ms x xs)

@@ -0,0 +1,72 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE TypeOperators #-}+module Main where++import Data.Monoid+import Data.Override+import GHC.Generics (Generic)+import Test.Hspec++main :: IO ()+main = hspec do+  describe "Override" do+    describe "Semigroup" do+      it "Rec1" testRec1'Semigroup+    describe "Monoid" do+      it "Rec1" testRec1'Monoid+    describe "Eq" do+      it "Rec2" testRec2'Eq+    describe "Ord" do+      it "Rec2" testRec2'Ord++-- | Overriding instances by type.+data Rec1 = Rec1+  { foo :: String+  , bar :: Bool+  } deriving stock (Show, Eq, Generic)+    deriving (Semigroup, Monoid)+      via Override Rec1+            '[ Bool `As` Any+             ]++testRec1'Semigroup :: IO ()+testRec1'Semigroup = do+  Rec1 { foo = "a",  bar = False }+    <> Rec1 { foo = "b",  bar = True }+      `shouldBe` Rec1 { foo = "ab", bar = True }++testRec1'Monoid :: IO ()+testRec1'Monoid = do+  mempty `shouldBe` Rec1 { foo = "", bar = False }+  Rec1 { foo = "a",  bar = False }+    `mappend` Rec1 { foo = "b",  bar = True }+      `shouldBe` Rec1 { foo = "ab", bar = True }++data Rec2 = Rec2 String Int+ deriving stock (Show, Generic)+ deriving (Eq, Ord) via (Override Rec2 '[String `As` ByLength])++newtype ByLength = ByLength { byLength :: String }+  deriving (Show)++instance Eq ByLength where+  ByLength x == ByLength y = length x == length y++instance Ord ByLength where+  ByLength x <= ByLength y = length x <= length y++testRec2'Eq :: IO ()+testRec2'Eq = do+  (Rec2 "foo" 0 == Rec2 "bar" 0) `shouldBe` True+  (Rec2 "foo" 0 == Rec2 "bar" 1) `shouldBe` False+  (Rec2 ""    0 == Rec2 "bar" 0) `shouldBe` False++testRec2'Ord :: IO ()+testRec2'Ord = do+  (Rec2 "foo" 0 <= Rec2 "bar" 0) `shouldBe` True+  (Rec2 "foo" 1 <= Rec2 "bar" 0) `shouldBe` False+  (Rec2 ""    0 >= Rec2 "bar" 0) `shouldBe` False