newtype-generics 0.5.2 → 0.5.2.1
raw patch · 9 files changed
+629/−629 lines, 9 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−4
- Control/Newtype.hs +372/−372
- LICENSE +30/−30
- README.md +38/−38
- Setup.hs +2/−2
- bench/main.hs +65/−65
- newtype-generics.cabal +58/−58
- test/Control/NewtypeSpec.hs +58/−58
- test/main.hs +2/−2
CHANGELOG.md view
@@ -1,4 +1,4 @@-* 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 +* 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,372 +1,372 @@-{-# 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 +{-# 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
@@ -1,65 +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 - ] - ] +{-# 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,58 +1,58 @@-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 +Name: newtype-generics+Version: 0.5.2.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 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,58 +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 - - it "under2" $ do - under2 Sum (<>) four five `shouldBe` 9 - - it "over2" $ do - over2 TestNewType (+) (TestNewType four) (TestNewType five) `shouldBe` TestNewType 9 - +{-# 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 #-}+