newtype-generics 0.5.1 → 0.5.2
raw patch · 9 files changed
+629/−505 lines, 9 filesdep +criteriondep +semigroupsdep ~HUnitdep ~basedep ~hspecsetup-changedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: criterion, semigroups
Dependency ranges changed: HUnit, base, hspec
API changes (from Hackage documentation)
+ Control.Newtype: over2 :: (Newtype n, Newtype n', o' ~ O n', o ~ O n) => (o -> n) -> (o -> o -> o') -> (n -> n -> n')
+ Control.Newtype: under2 :: (Newtype n, Newtype n', o' ~ O n', o ~ O n) => (o -> n) -> (n -> n -> n') -> (o -> o -> o')
- Control.Newtype: class Newtype n where type O n :: * type O n = GO (Rep n) pack = to . gpack unpack = gunpack . from where {
+ Control.Newtype: class Newtype n where {
Files
- CHANGELOG.md +4/−3
- Control/Newtype.hs +372/−331
- LICENSE +30/−30
- README.md +38/−38
- Setup.hs +2/−2
- bench/main.hs +65/−0
- newtype-generics.cabal +58/−47
- test/Control/NewtypeSpec.hs +58/−52
- test/main.hs +2/−2
CHANGELOG.md view
@@ -1,3 +1,4 @@-* 0.5.1 - Add more instances from base-* 0.5.0.1 - Compatibility with GHC 8.2.1-* 0.5 - Relax types of underF and overF to allow different input & output funtors+* 0.5.2 - Add `under2` and `over2`, documentation improvements +* 0.5.1 - Add more instances from base +* 0.5.0.1 - Compatibility with GHC 8.2.1 +* 0.5 - Relax types of underF and overF to allow different input & output funtors
Control/Newtype.hs view
@@ -1,331 +1,372 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE UndecidableInstances #-}-{- |-The 'Newtype' typeclass and related functions: 'op', 'ala', 'ala'', 'under'.-Primarly pulled from Conor McBride's Epigram work. Some examples:--@ala Sum foldMap [1,2,3,4] -- foldMaps the list ala the Sum newtype. This results in 10.@--@ala Product foldMap [1,2,3,4] -- foldMaps the list ala the Product newtype. This results in 24.@--@ala Endo foldMap [(+1), (+2), (subtract 1), (*2)] 3 -- foldMaps the list ala the Endo newtype. This results in 8.@--NB: 'Data.Foldable.foldMap' is a generalized @mconcatMap@ which is a generalized @concatMap@.--This package includes 'Newtype' instances for all the (non-GHC\/foreign)-newtypes in base (as seen in the examples).-However, there are neat things you can do with this with-/any/ newtype and you should definitely define your own 'Newtype'-instances for the power of this library.-For example, see @ala Cont traverse@, with the proper 'Newtype' instance for Cont.-You can easily define new instances for your newtypes with the help of GHC.Generics-- > {-# LANGUAGE DeriveGeneric #-}- > import GHC.Generics- >- > (...)- > newtype Example = Example Int - > deriving (Generic)- >- > instance Newtype Example- >--This avoids the use of Template Haskell (TH) to get new instances.--}-module Control.Newtype- ( Newtype(..)- , op- , ala- , ala'- , under- , over- , underF- , overF- ) where--import Control.Applicative-import Control.Arrow-import Data.Functor.Compose-import Data.Functor.Identity-#if MIN_VERSION_base(4,7,0)-import Data.Fixed-#endif-import Data.Monoid-import Data.Ord-#if MIN_VERSION_base(4,9,0)-import qualified Data.Semigroup-import Data.Semigroup (Min(..), Max(..), WrappedMonoid(..), Option(..))-#endif-import GHC.Generics-{-import Generics.Deriving-}---- | Given a newtype @n@, we will always have the same unwrapped type @o@,--- meaning we can represent this with a fundep @n -> o@.------ Any instance of this class just needs to let @pack@ equal to the newtype's--- constructor, and let @unpack@ destruct the newtype with pattern matching.-{-class Newtype n o | n -> o where-}- {-pack :: o -> n-}- {-unpack :: n -> o-}----- Generic Newtype-class GNewtype n where- type GO n :: *- gpack :: GO n -> n p- gunpack :: n p -> GO n---- We only need one instance, if these generic functions are only to work for--- newtypes, as these have a fixed form. For example, for a newtype X = Y,--- Rep X = D1 ... (C1 ... (S1 ... (K1 ... Y)))-instance GNewtype (D1 d (C1 c (S1 s (K1 i a)))) where- type GO (D1 d (C1 c (S1 s (K1 i a)))) = a- gpack x = M1 (M1 (M1 (K1 x)))- gunpack (M1 (M1 (M1 (K1 x)))) = x---- Original Newtype class, extended with generic defaults (trivial) and deprived--- of the second type argument (less trivial, as it involves a type family with--- a default, plus an equality constraint for the related type family in--- GNewtype). We do get rid of MultiParamTypeClasses and FunctionalDependencies,--- though.---- | As long as the type @n@ is an instance of Generic, you can create an instance--- with just @instance Newtype n@-class Newtype n where- type O n :: *- type O n = GO (Rep n)-- pack :: O n -> n- default pack :: (Generic n, GNewtype (Rep n), O n ~ GO (Rep n)) => O n -> n- pack = to . gpack-- unpack :: n -> O n- default unpack :: (Generic n, GNewtype (Rep n), O n ~ GO (Rep n)) => n -> O n- unpack = gunpack . from---- |--- This function serves two purposes:------ 1. Giving you the unpack of a newtype without you needing to remember the name.------ 2. Showing that the first parameter is /completely ignored/ on the value level,--- meaning the only reason you pass in the constructor is to provide type--- information. Typeclasses sure are neat.-op :: (Newtype n,o ~ O n ) => (o -> n) -> n -> o-op _ = unpack---- | The workhorse of the package. Given a pack and a \"higher order function\",--- it handles the packing and unpacking, and just sends you back a regular old--- function, with the type varying based on the hof you passed.------ The reason for the signature of the hof is due to 'ala' not caring about structure.--- To illustrate why this is important, another function in this package is 'under'.--- It is not extremely useful; @under2@ might be more useful (with e.g., @mappend@),--- but then we already digging the trench of--- \"What about @under3@? @under4@?\".--- The solution utilized here is to just hand off the \"packer\" to the hof.--- That way your structure can be imposed in the hof,--- whatever you may want it to be (e.g., List, Traversable).-ala :: (Newtype n, Newtype n', o' ~ O n', o ~ O n)- => (o -> n) -> ((o -> n) -> b -> n') -> (b -> o')-ala pa hof = ala' pa hof id---- | This is the original function seen in Conor McBride's work.--- The way it differs from the 'ala' function in this package,--- is that it provides an extra hook into the \"packer\" passed to the hof.--- However, this normally ends up being @id@, so 'ala' wraps this function and--- passes @id@ as the final parameter by default.--- If you want the convenience of being able to hook right into the hof,--- you may use this function.-ala' :: (Newtype n, Newtype n', o' ~ O n', o ~ O n)- => (o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> (b -> o')-ala' _ hof f = unpack . hof (pack . f)---- | A very simple operation involving running the function \'under\' the newtype.--- Suffers from the problems mentioned in the 'ala' function's documentation.-under :: (Newtype n, Newtype n', o' ~ O n', o ~ O n)- => (o -> n) -> (n -> n') -> (o -> o')-under _ f = unpack . f . pack---- | The opposite of 'under'. I.e., take a function which works on the--- underlying types, and switch it to a function that works on the newtypes.-over :: (Newtype n, Newtype n', o' ~ O n', o ~ O n)- => (o -> n) -> (o -> o') -> (n -> n')-over _ f = pack . f . unpack---- | 'under' lifted into a Functor.-underF :: (Newtype n, Newtype n', o' ~ O n', o ~ O n, Functor f, Functor g)- => (o -> n) -> (f n -> g n') -> (f o -> g o')-underF _ f = fmap unpack . f . fmap pack---- | 'over' lifted into a Functor.-overF :: (Newtype n, Newtype n', o' ~ O n', o ~ O n, Functor f, Functor g)- => (o -> n) -> (f o -> g o') -> (f n -> g n')-overF _ f = fmap pack . f . fmap unpack---- Instances from Control.Applicative--instance Newtype (WrappedMonad m a) where- type O (WrappedMonad m a) = m a- pack = WrapMonad- unpack (WrapMonad a) = a--instance Newtype (WrappedArrow a b c) where- type O (WrappedArrow a b c) = a b c- pack = WrapArrow- unpack (WrapArrow a) = a--instance Newtype (ZipList a) where- type O (ZipList a) = [a]- pack = ZipList- unpack (ZipList a) = a---- Instances from Control.Arrow--instance Newtype (Kleisli m a b) where- type O (Kleisli m a b) = a -> m b- pack = Kleisli- unpack (Kleisli a) = a--instance Newtype (ArrowMonad a b) where- type O (ArrowMonad a b) = a () b- pack = ArrowMonad- unpack (ArrowMonad a) = a--#if MIN_VERSION_base(4,7,0)--- Instances from Data.Fixed---- | @since 0.5.1-instance Newtype (Fixed a) where- type O (Fixed a) = Integer- pack = MkFixed- unpack (MkFixed x) = x-#endif---- Instances from Data.Functor.Compose---- | @since 0.5.1-instance Newtype (Compose f g a) where- type O (Compose f g a) = f (g a)- pack = Compose- unpack (Compose x) = x---- Instances from Data.Functor.Const--instance Newtype (Const a x) where- type O (Const a x) = a- pack = Const- unpack (Const a) = a---- Instances from Data.Functor.Identity---- | @since 0.5.1-instance Newtype (Identity a) where- type O (Identity a) = a- pack = Identity- unpack (Identity a) = a---- Instances from Data.Monoid---- | @since 0.5.1-instance Newtype (Dual a) where- type O (Dual a) = a- pack = Dual- unpack (Dual a) = a--instance Newtype (Endo a) where- type O (Endo a) = (a -> a)- pack = Endo- unpack (Endo a) = a--instance Newtype All where- type O All = Bool- pack = All- unpack (All x) = x--instance Newtype Any where- type O Any = Bool- pack = Any- unpack (Any x) = x--instance Newtype (Sum a) where- type O (Sum a) = a- pack = Sum- unpack (Sum a) = a--instance Newtype (Product a) where- type O (Product a) = a- pack = Product- unpack (Product a) = a--instance Newtype (First a) where- type O (First a) = Maybe a- pack = First- unpack (First a) = a--instance Newtype (Last a) where- type O (Last a) = Maybe a- pack = Last- unpack (Last a) = a--#if MIN_VERSION_base(4,8,0)--- | @since 0.5.1-instance Newtype (Alt f a) where- type O (Alt f a) = f a- pack = Alt- unpack (Alt x) = x-#endif---- Instances from Data.Ord---- | @since 0.5.1-instance Newtype (Down a) where- type O (Down a) = a- pack = Down- unpack (Down a) = a---#if MIN_VERSION_base(4,9,0)--- Instances from Data.Semigroup---- | @since 0.5.1-instance Newtype (Min a) where- type O (Min a) = a- pack = Min- unpack (Min a) = a---- | @since 0.5.1-instance Newtype (Max a) where- type O (Max a) = a- pack = Max- unpack (Max a) = a---- | @since 0.5.1-instance Newtype (Data.Semigroup.First a) where- type O (Data.Semigroup.First a) = a- pack = Data.Semigroup.First- unpack (Data.Semigroup.First a) = a---- | @since 0.5.1-instance Newtype (Data.Semigroup.Last a) where- type O (Data.Semigroup.Last a) = a- pack = Data.Semigroup.Last- unpack (Data.Semigroup.Last a) = a---- | @since 0.5.1-instance Newtype (WrappedMonoid m) where- type O (WrappedMonoid m) = m- pack = WrapMonoid- unpack (WrapMonoid m) = m---- | @since 0.5.1-instance Newtype (Option a) where- type O (Option a) = Maybe a- pack = Option- unpack (Option x) = x-#endif+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +{- | +The 'Newtype' typeclass and related functions. +Primarily pulled from Conor McBride's Epigram work. Some examples: + +>>> ala Sum foldMap [1,2,3,4] +10 + +>>> ala Endo foldMap [(+1), (+2), (subtract 1), (*2)] 3 +8 + +>>> under2 Min (<>) 2 1 +1 + +>>> over All not (All False) +All {getAll = True) + +This package includes 'Newtype' instances for all the (non-GHC\/foreign) +newtypes in base (as seen in the examples). +However, there are neat things you can do with this with +/any/ newtype and you should definitely define your own 'Newtype' +instances for the power of this library. +For example, see @ala Cont traverse@, with the proper 'Newtype' instance for Cont. +You can easily define new instances for your newtypes with the help of GHC.Generics + + > {-# LANGUAGE DeriveGeneric #-} + > import GHC.Generics + > + > (...) + > newtype Example = Example Int + > deriving (Generic) + > + > instance Newtype Example + > + +This avoids the use of Template Haskell (TH) to get new instances. +-} +module Control.Newtype + ( Newtype(..) + , op + , ala + , ala' + , under + , over + , under2 + , over2 + , underF + , overF + ) where + +import Control.Applicative +import Control.Arrow +import Data.Functor.Compose +import Data.Functor.Identity +#if MIN_VERSION_base(4,7,0) +import Data.Fixed +#endif +import Data.Monoid +import Data.Ord +#if MIN_VERSION_base(4,9,0) +import qualified Data.Semigroup +import Data.Semigroup (Min(..), Max(..), WrappedMonoid(..), Option(..)) +#endif +import GHC.Generics +{-import Generics.Deriving-} + +-- | Given a newtype @n@, we will always have the same unwrapped type @o@, +-- meaning we can represent this with a fundep @n -> o@. +-- +-- Any instance of this class just needs to let @pack@ equal to the newtype's +-- constructor, and let @unpack@ destruct the newtype with pattern matching. +{-class Newtype n o | n -> o where-} + {-pack :: o -> n-} + {-unpack :: n -> o-} + + +-- Generic Newtype +class GNewtype n where + type GO n :: * + gpack :: GO n -> n p + gunpack :: n p -> GO n + +-- We only need one instance, if these generic functions are only to work for +-- newtypes, as these have a fixed form. For example, for a newtype X = Y, +-- Rep X = D1 ... (C1 ... (S1 ... (K1 ... Y))) +instance GNewtype (D1 d (C1 c (S1 s (K1 i a)))) where + type GO (D1 d (C1 c (S1 s (K1 i a)))) = a + gpack x = M1 (M1 (M1 (K1 x))) + gunpack (M1 (M1 (M1 (K1 x)))) = x + +-- Original Newtype class, extended with generic defaults (trivial) and deprived +-- of the second type argument (less trivial, as it involves a type family with +-- a default, plus an equality constraint for the related type family in +-- GNewtype). We do get rid of MultiParamTypeClasses and FunctionalDependencies, +-- though. + +-- | As long as the type @n@ is an instance of Generic, you can create an instance +-- with just @instance Newtype n@ +class Newtype n where + type O n :: * + type O n = GO (Rep n) + + pack :: O n -> n + default pack :: (Generic n, GNewtype (Rep n), O n ~ GO (Rep n)) => O n -> n + pack = to . gpack + + unpack :: n -> O n + default unpack :: (Generic n, GNewtype (Rep n), O n ~ GO (Rep n)) => n -> O n + unpack = gunpack . from + +-- | +-- This function serves two purposes: +-- +-- 1. Giving you the unpack of a newtype without you needing to remember the name. +-- +-- 2. Showing that the first parameter is /completely ignored/ on the value level, +-- meaning the only reason you pass in the constructor is to provide type +-- information. Typeclasses sure are neat. +-- +-- >>> op Identity (Identity 3) +-- 3 +op :: (Newtype n,o ~ O n ) => (o -> n) -> n -> o +op _ = unpack + +-- | The workhorse of the package. Given a "packer" and a \"higher order function\" (/hof/), +-- it handles the packing and unpacking, and just sends you back a regular old +-- function, with the type varying based on the /hof/ you passed. +-- +-- The reason for the signature of the /hof/ is due to 'ala' not caring about structure. +-- To illustrate why this is important, consider this alternative implementation of 'under2': +-- +-- > under2 :: (Newtype n, Newtype n', o' ~ O n', o ~ O n) +-- > => (o -> n) -> (n -> n -> n') -> (o -> o -> o') +-- > under2' pa f o0 o1 = ala pa (\p -> uncurry f . bimap p p) (o0, o1) +-- +-- Being handed the "packer", the /hof/ may apply it in any structure of its choosing – +-- in this case a tuple. +-- +-- >>> ala Sum foldMap [1,2,3,4] +-- 10 +ala :: (Newtype n, Newtype n', o' ~ O n', o ~ O n) + => (o -> n) -> ((o -> n) -> b -> n') -> (b -> o') +ala pa hof = ala' pa hof id + +-- | This is the original function seen in Conor McBride's work. +-- The way it differs from the 'ala' function in this package, +-- is that it provides an extra hook into the \"packer\" passed to the hof. +-- However, this normally ends up being @id@, so 'ala' wraps this function and +-- passes @id@ as the final parameter by default. +-- If you want the convenience of being able to hook right into the hof, +-- you may use this function. +-- +-- >>> ala' Sum foldMap length ["hello", "world"] +-- 10 +-- +-- >>> ala' First foldMap (readMaybe @Int) ["x", "42", "1"] +-- Just 42 +ala' :: (Newtype n, Newtype n', o' ~ O n', o ~ O n) + => (o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> (b -> o') +ala' _ hof f = unpack . hof (pack . f) + +-- | A very simple operation involving running the function \'under\' the newtype. +-- +-- >>> under Product (stimes 3) 3 +-- 27 +under :: (Newtype n, Newtype n', o' ~ O n', o ~ O n) + => (o -> n) -> (n -> n') -> (o -> o') +under _ f = unpack . f . pack + +-- | The opposite of 'under'. I.e., take a function which works on the +-- underlying types, and switch it to a function that works on the newtypes. +-- +-- >>> over All not (All False) +-- All {getAll = True} +over :: (Newtype n, Newtype n', o' ~ O n', o ~ O n) + => (o -> n) -> (o -> o') -> (n -> n') +over _ f = pack . f . unpack + +-- | Lower a binary function to operate on the underlying values. +-- +-- >>> under2 Any (<>) True False +-- True +-- +-- @since 0.5.2 +under2 :: (Newtype n, Newtype n', o' ~ O n', o ~ O n) + => (o -> n) -> (n -> n -> n') -> (o -> o -> o') +under2 _ f o0 o1 = unpack $ f (pack o0) (pack o1) + +-- | The opposite of 'under2'. +-- +-- @since 0.5.2 +over2 :: (Newtype n, Newtype n', o' ~ O n', o ~ O n) + => (o -> n) -> (o -> o -> o') -> (n -> n -> n') +over2 _ f n0 n1 = pack $ f (unpack n0) (unpack n1) + +-- | 'under' lifted into a Functor. +underF :: (Newtype n, Newtype n', o' ~ O n', o ~ O n, Functor f, Functor g) + => (o -> n) -> (f n -> g n') -> (f o -> g o') +underF _ f = fmap unpack . f . fmap pack + +-- | 'over' lifted into a Functor. +overF :: (Newtype n, Newtype n', o' ~ O n', o ~ O n, Functor f, Functor g) + => (o -> n) -> (f o -> g o') -> (f n -> g n') +overF _ f = fmap pack . f . fmap unpack + +-- Instances from Control.Applicative + +instance Newtype (WrappedMonad m a) where + type O (WrappedMonad m a) = m a + pack = WrapMonad + unpack (WrapMonad a) = a + +instance Newtype (WrappedArrow a b c) where + type O (WrappedArrow a b c) = a b c + pack = WrapArrow + unpack (WrapArrow a) = a + +instance Newtype (ZipList a) where + type O (ZipList a) = [a] + pack = ZipList + unpack (ZipList a) = a + +-- Instances from Control.Arrow + +instance Newtype (Kleisli m a b) where + type O (Kleisli m a b) = a -> m b + pack = Kleisli + unpack (Kleisli a) = a + +instance Newtype (ArrowMonad a b) where + type O (ArrowMonad a b) = a () b + pack = ArrowMonad + unpack (ArrowMonad a) = a + +#if MIN_VERSION_base(4,7,0) +-- Instances from Data.Fixed + +-- | @since 0.5.1 +instance Newtype (Fixed a) where + type O (Fixed a) = Integer + pack = MkFixed + unpack (MkFixed x) = x +#endif + +-- Instances from Data.Functor.Compose + +-- | @since 0.5.1 +instance Newtype (Compose f g a) where + type O (Compose f g a) = f (g a) + pack = Compose + unpack (Compose x) = x + +-- Instances from Data.Functor.Const + +instance Newtype (Const a x) where + type O (Const a x) = a + pack = Const + unpack (Const a) = a + +-- Instances from Data.Functor.Identity + +-- | @since 0.5.1 +instance Newtype (Identity a) where + type O (Identity a) = a + pack = Identity + unpack (Identity a) = a + +-- Instances from Data.Monoid + +-- | @since 0.5.1 +instance Newtype (Dual a) where + type O (Dual a) = a + pack = Dual + unpack (Dual a) = a + +instance Newtype (Endo a) where + type O (Endo a) = (a -> a) + pack = Endo + unpack (Endo a) = a + +instance Newtype All where + type O All = Bool + pack = All + unpack (All x) = x + +instance Newtype Any where + type O Any = Bool + pack = Any + unpack (Any x) = x + +instance Newtype (Sum a) where + type O (Sum a) = a + pack = Sum + unpack (Sum a) = a + +instance Newtype (Product a) where + type O (Product a) = a + pack = Product + unpack (Product a) = a + +instance Newtype (First a) where + type O (First a) = Maybe a + pack = First + unpack (First a) = a + +instance Newtype (Last a) where + type O (Last a) = Maybe a + pack = Last + unpack (Last a) = a + +#if MIN_VERSION_base(4,8,0) +-- | @since 0.5.1 +instance Newtype (Alt f a) where + type O (Alt f a) = f a + pack = Alt + unpack (Alt x) = x +#endif + +-- Instances from Data.Ord + +-- | @since 0.5.1 +instance Newtype (Down a) where + type O (Down a) = a + pack = Down + unpack (Down a) = a + + +#if MIN_VERSION_base(4,9,0) +-- Instances from Data.Semigroup + +-- | @since 0.5.1 +instance Newtype (Min a) where + type O (Min a) = a + pack = Min + unpack (Min a) = a + +-- | @since 0.5.1 +instance Newtype (Max a) where + type O (Max a) = a + pack = Max + unpack (Max a) = a + +-- | @since 0.5.1 +instance Newtype (Data.Semigroup.First a) where + type O (Data.Semigroup.First a) = a + pack = Data.Semigroup.First + unpack (Data.Semigroup.First a) = a + +-- | @since 0.5.1 +instance Newtype (Data.Semigroup.Last a) where + type O (Data.Semigroup.Last a) = a + pack = Data.Semigroup.Last + unpack (Data.Semigroup.Last a) = a + +-- | @since 0.5.1 +instance Newtype (WrappedMonoid m) where + type O (WrappedMonoid m) = m + pack = WrapMonoid + unpack (WrapMonoid m) = m + +-- | @since 0.5.1 +instance Newtype (Option a) where + type O (Option a) = Maybe a + pack = Option + unpack (Option x) = x +#endif
LICENSE view
@@ -1,30 +1,30 @@-Copyright (c)2011, Darius Jahandarie--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:-- * Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.-- * Redistributions in binary form must reproduce the above- copyright notice, this list of conditions and the following- disclaimer in the documentation and/or other materials provided- with the distribution.-- * Neither the name of Darius Jahandarie nor the names of other- contributors may be used to endorse or promote products derived- from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+Copyright (c)2011, Darius Jahandarie + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Darius Jahandarie nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md view
@@ -1,38 +1,38 @@-newtype-generics-================--A typeclass and set of functions for working with newtypes.-Fork of the code published by Darius Jahandarie [here](http://hackage.haskell.org/package/newtype-0.2),-with the addition of generics.--The 'Newtype' typeclass and related functions: `op`, `ala`, `ala'`, `under`. -Primarly pulled from Conor McBride's Epigram work. Some examples:--```--- foldMaps the list ala the Sum newtype. This results in 10.-ala Sum foldMap [1,2,3,4] ---- foldMaps the list ala the Product newtype. This results in 24.-ala Product foldMap [1,2,3,4] ---- foldMaps the list ala the Endo newtype. This results in 8.-ala Endo foldMap [(+1), (+2), (subtract 1), (*2)] 3 -```--_NB:_ `Data.Foldable.foldMap` is a generalized `mconcatMap` which is a generalized `concatMap`.--This package includes `Newtype` instances for all the (non-GHC/foreign) newtypes in base (as seen in the examples).-However, there are neat things you can do with this with /any/ newtype and you should definitely define your own 'Newtype' instances for the power of this library.-For example, see `ala Cont traverse`, with the proper `Newtype` instance for Cont.--This could of course be eased with the addition of generics for version 0.3:--```-{-# LANGUAGE DeriveGeneric #-}--import GHC.Generics-(...)-newtype Example = Example Int (deriving Generic)-instance Newtype Example-```-+newtype-generics +================ + +A typeclass and set of functions for working with newtypes. +Fork of the code published by Darius Jahandarie [here](http://hackage.haskell.org/package/newtype-0.2), +with the addition of generics. + +The 'Newtype' typeclass and related functions: `op`, `ala`, `ala'`, `under`. +Primarly pulled from Conor McBride's Epigram work. Some examples: + +``` +-- foldMaps the list ala the Sum newtype. This results in 10. +ala Sum foldMap [1,2,3,4] + +-- foldMaps the list ala the Product newtype. This results in 24. +ala Product foldMap [1,2,3,4] + +-- foldMaps the list ala the Endo newtype. This results in 8. +ala Endo foldMap [(+1), (+2), (subtract 1), (*2)] 3 +``` + +_NB:_ `Data.Foldable.foldMap` is a generalized `mconcatMap` which is a generalized `concatMap`. + +This package includes `Newtype` instances for all the (non-GHC/foreign) newtypes in base (as seen in the examples). +However, there are neat things you can do with this with /any/ newtype and you should definitely define your own 'Newtype' instances for the power of this library. +For example, see `ala Cont traverse`, with the proper `Newtype` instance for Cont. + +This could of course be eased with the addition of generics for version 0.3: + +``` +{-# LANGUAGE DeriveGeneric #-} + +import GHC.Generics +(...) +newtype Example = Example Int (deriving Generic) +instance Newtype Example +``` +
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple +main = defaultMain
+ bench/main.hs view
@@ -0,0 +1,65 @@+{-# language DeriveGeneric #-} +{-# language TypeFamilies #-} +module Main where + +import Criterion +import Criterion.Main +import Control.Newtype +import Data.Coerce +import Data.Semigroup +import GHC.Generics + +newtype MySumDerive = MySumDerive Int + deriving (Generic) +instance Newtype MySumDerive +instance Semigroup MySumDerive where + MySumDerive x <> MySumDerive y = MySumDerive (x + y) +instance Monoid MySumDerive where + mappend = (<>) + mempty = MySumDerive 0 + +newtype MySumManual = MySumManual Int +instance Newtype MySumManual where + type O MySumManual = Int + pack = MySumManual + unpack (MySumManual x) = x +instance Semigroup MySumManual where + MySumManual x <> MySumManual y = MySumManual (x + y) +instance Monoid MySumManual where + mappend = (<>) + mempty = MySumManual 0 + +mySumDerive :: [Int] -> Int +mySumDerive xs = ala MySumDerive foldMap xs + +mySumManual :: [Int] -> Int +mySumManual xs = ala MySumManual foldMap xs + +mySumOldschool :: [Int] -> Int +mySumOldschool xs = s + where MySumDerive s = foldMap MySumDerive xs + +mySumCoerce :: [Int] -> Int +mySumCoerce xs = coerce (foldMap coerce xs :: MySumDerive) + +mySumCoerce' :: [Int] -> Int +mySumCoerce' xs = coerce (mconcat (coerce xs) :: MySumDerive) + +preludeSum :: [Int] -> Int +preludeSum xs = sum xs + +main :: IO () +main = defaultMain [ + env (return [1..5 :: Int]) $ \ns -> + let bench' s f = bench s (whnf f ns) + in bgroup "[1..5 :: Int]" + [ bgroup "foldMap" + [ bench' "ala MySumDerive" mySumDerive + , bench' "ala MySumManual" mySumManual + , bench' "manual wrap & unwrap" mySumOldschool + , bench' "coerce" mySumCoerce + ] + , bench' "coerce . mconcat . coerce" mySumCoerce' + , bench' "Prelude.sum" preludeSum + ] + ]
newtype-generics.cabal view
@@ -1,47 +1,58 @@-Name: newtype-generics-Version: 0.5.1-Synopsis: A typeclass and set of functions for working with newtypes, with generics support.-Description: Per Conor McBride, the Newtype typeclass represents the packing and unpacking of a newtype,- and allows you to operatate under that newtype with functions such as ala.- Generics support was added in version 0.4, making this package a full replacement- for the original newtype package, and a better alternative to newtype-th.-License: BSD3-License-file: LICENSE-Author: Darius Jahandarie, Conor McBride, João Cristóvão-Maintainer: Simon Jakobi <simon.jakobi@gmail.com>--- Copyright: -Category: Control-Build-type: Simple-Extra-source-files: CHANGELOG.md, README.md-Cabal-version: >=1.10-Tested-with:- GHC==8.2.1,- GHC==8.0.2,- GHC==7.10.3,- GHC==7.8.4,- GHC==7.6.3--Library- Exposed-modules: Control.Newtype- Build-depends: base >= 4.6 && < 4.11- , transformers- -- Other-modules: - -- Build-tools: - Ghc-options: -Wall- default-language: Haskell2010--source-repository head- type: git- location: https://github.com/jcristovao/newtype-generics--test-suite test- type: exitcode-stdio-1.0- main-is: main.hs- hs-source-dirs: test- other-modules: Control.NewtypeSpec- build-depends: base- , newtype-generics- , hspec >= 2.1 && < 2.5- , HUnit >= 1.2.5.2 && < 1.7- default-language: Haskell2010- build-tool-depends: hspec-discover:hspec-discover >= 2.1 && <2.5+Name: newtype-generics +Version: 0.5.2 +Synopsis: A typeclass and set of functions for working with newtypes, with generics support. +Description: Per Conor McBride, the Newtype typeclass represents the packing and unpacking of a newtype, + and allows you to operate under that newtype with functions such as ala. + Generics support was added in version 0.4, making this package a full replacement + for the original newtype package, and a better alternative to newtype-th. +License: BSD3 +License-file: LICENSE +Author: Darius Jahandarie, Conor McBride, João Cristóvão +Maintainer: Simon Jakobi <simon.jakobi@gmail.com> +-- Copyright: +Category: Control +Build-type: Simple +Extra-source-files: CHANGELOG.md, README.md +Cabal-version: >=1.10 +Tested-with: + GHC==8.2.1, + GHC==8.0.2, + GHC==7.10.3, + GHC==7.8.4, + GHC==7.6.3 + +Library + Exposed-modules: Control.Newtype + Build-depends: base >= 4.6 && < 4.11 + , transformers + -- Other-modules: + -- Build-tools: + Ghc-options: -Wall + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/jcristovao/newtype-generics + +test-suite test + type: exitcode-stdio-1.0 + main-is: main.hs + hs-source-dirs: test + other-modules: Control.NewtypeSpec + build-depends: base + , newtype-generics + , hspec >= 2.1 + , HUnit >= 1.2.5.2 + default-language: Haskell2010 + build-tool-depends: hspec-discover:hspec-discover >= 2.1 && <2.5 + +benchmark bench + type: exitcode-stdio-1.0 + main-is: main.hs + hs-source-dirs: bench + build-depends: base + , criterion + , newtype-generics + , semigroups + ghc-options: -O2 + default-language: Haskell2010
test/Control/NewtypeSpec.hs view
@@ -1,52 +1,58 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}--module Control.NewtypeSpec where--import Prelude--import Data.Monoid-import Control.Newtype-import GHC.Generics--import Test.Hspec--newtype TestNewType = TestNewType Int deriving (Eq,Show,Generic)--instance Newtype TestNewType--{-# ANN spec ("HLint: ignore Redundant do"::String) #-}-spec :: Spec-spec = describe "Newtype test" $ do- let four = 4 :: Int- five = 5 :: Int- noth = Nothing :: Maybe String- it "pack" $ do- (pack True :: All) `shouldBe` All True- (pack True :: Any) `shouldBe` Any True- (pack (Just five) :: First Int) `shouldBe` First (Just 5)-- it "unpack" $ do- unpack (Any False) `shouldBe` False- unpack (First (Just five)) `shouldBe` Just five- unpack (Last noth) `shouldBe` Nothing- unpack (TestNewType five) `shouldBe` five-- it "op" $ do- op All (All True) `shouldBe` True- op Any (Any False) `shouldBe` False- op Sum (Sum five) `shouldBe` five-- it "under" $ do- let sumLess (Sum x) = Sum (x - 1)- firstN (_) = First Nothing- under Sum sumLess five `shouldBe` four- under First firstN (Just five) `shouldBe` (Nothing :: Maybe Int)-- it "over" $ do- over Sum (+1) (Sum four) `shouldBe` Sum five- over Product (+1) (Product four) `shouldBe` Product five-+{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +module Control.NewtypeSpec where + +import Prelude + +import Data.Monoid +import Control.Newtype +import GHC.Generics + +import Test.Hspec + +newtype TestNewType = TestNewType Int deriving (Eq,Show,Generic) + +instance Newtype TestNewType + +{-# ANN spec ("HLint: ignore Redundant do"::String) #-} +spec :: Spec +spec = describe "Newtype test" $ do + let four = 4 :: Int + five = 5 :: Int + noth = Nothing :: Maybe String + it "pack" $ do + (pack True :: All) `shouldBe` All True + (pack True :: Any) `shouldBe` Any True + (pack (Just five) :: First Int) `shouldBe` First (Just 5) + + it "unpack" $ do + unpack (Any False) `shouldBe` False + unpack (First (Just five)) `shouldBe` Just five + unpack (Last noth) `shouldBe` Nothing + unpack (TestNewType five) `shouldBe` five + + it "op" $ do + op All (All True) `shouldBe` True + op Any (Any False) `shouldBe` False + op Sum (Sum five) `shouldBe` five + + it "under" $ do + let sumLess (Sum x) = Sum (x - 1) + firstN (_) = First Nothing + under Sum sumLess five `shouldBe` four + under First firstN (Just five) `shouldBe` (Nothing :: Maybe Int) + + it "over" $ do + over Sum (+1) (Sum four) `shouldBe` Sum five + over Product (+1) (Product four) `shouldBe` Product five + + it "under2" $ do + under2 Sum (<>) four five `shouldBe` 9 + + it "over2" $ do + over2 TestNewType (+) (TestNewType four) (TestNewType five) `shouldBe` TestNewType 9 +
test/main.hs view
@@ -1,2 +1,2 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}-+{-# OPTIONS_GHC -F -pgmF hspec-discover #-} +