newtype-generics-0.5.4/0000755000000000000000000000000007346545000013201 5ustar0000000000000000newtype-generics-0.5.4/CHANGELOG.md0000755000000000000000000000252307346545000015017 0ustar0000000000000000# Changelog for `newtype-generics` ## [0.5.4] – 2019-09-10 - Add `Newtype` instance for `Data.Monoid.Ap`. - Support GHC-8.8. ## [0.5.3] – 2018-03-23 - All code was moved to a new `Control.Newtype.Generics` module. - `Control.Newtype` re-exports `Control.Newtype.Generics`, but is deprecated and will be removed in the next major release. ## [0.5.2.2] – 2018-03-16 - Adjust bounds for `base` and `transformers` ## [0.5.2.1] – 2018-02-16 - Reupload due to README encoding issue ## [0.5.2] – 2018-02-16 ### Added - `under2` - `over2` ### Other - Various documentation improvements ## [0.5.1] ### Added - Add more instances from base ## 0.5.0.1 ### Changes - Compatibility with GHC 8.2.1 ## 0.5 ### Changes - Relax types of `underF` and `overF` to allow different input & output functors [Unreleased]: https://github.com/sjakobi/newtype-generics/compare/v0.5.4...HEAD [0.5.4]: https://github.com/sjakobi/newtype-generics/compare/v0.5.3...v0.5.4 [0.5.3]: https://github.com/sjakobi/newtype-generics/compare/v0.5.2.2...v0.5.3 [0.5.2.2]: https://github.com/sjakobi/newtype-generics/compare/v0.5.2.1...v0.5.2.2 [0.5.2.1]: https://github.com/sjakobi/newtype-generics/compare/v0.5.2...v0.5.2.1 [0.5.2]: https://github.com/sjakobi/newtype-generics/compare/v0.5.1...v0.5.2 [0.5.1]: https://github.com/sjakobi/newtype-generics/compare/v0.5.0.1...v0.5.1 newtype-generics-0.5.4/Control/0000755000000000000000000000000007346545000014621 5ustar0000000000000000newtype-generics-0.5.4/Control/Newtype.hs0000644000000000000000000000024707346545000016613 0ustar0000000000000000module Control.Newtype {-# deprecated "Import \"Control.Newtype.Generics\" instead" #-} ( module Control.Newtype.Generics ) where import Control.Newtype.Generics newtype-generics-0.5.4/Control/Newtype/0000755000000000000000000000000007346545000016254 5ustar0000000000000000newtype-generics-0.5.4/Control/Newtype/Generics.hs0000644000000000000000000002445107346545000020355 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# 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.Generics ( 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 #if MIN_VERSION_base(4,12,0) -- | @since Unreleased instance Newtype (Ap f a) where type O (Ap f a) = f a pack = Ap unpack = getAp #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 newtype-generics-0.5.4/LICENSE0000644000000000000000000000277307346545000014217 0ustar0000000000000000Copyright (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. newtype-generics-0.5.4/Setup.hs0000644000000000000000000000005607346545000014636 0ustar0000000000000000import Distribution.Simple main = defaultMain newtype-generics-0.5.4/bench/0000755000000000000000000000000007346545000014260 5ustar0000000000000000newtype-generics-0.5.4/bench/main.hs0000644000000000000000000000336407346545000015546 0ustar0000000000000000{-# language DeriveGeneric #-} {-# language TypeFamilies #-} module Main where import Gauge import Control.Newtype.Generics import Data.Coerce import Data.Foldable (foldMap) 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-0.5.4/newtype-generics.cabal0000644000000000000000000000401607346545000017456 0ustar0000000000000000Name: newtype-generics Version: 0.5.4 Synopsis: A typeclass and set of functions for working with newtypes 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, Simon Jakobi Maintainer: Simon Jakobi Homepage: http://github.com/sjakobi/newtype-generics Category: Control Build-type: Simple Extra-source-files: CHANGELOG.md Cabal-version: >=1.10 Tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3 Library Exposed-modules: Control.Newtype , Control.Newtype.Generics Build-depends: base >= 4.6 && < 4.14 , transformers < 0.6 Ghc-options: -Wall default-language: Haskell2010 source-repository head type: git location: https://github.com/sjakobi/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 default-language: Haskell2010 build-tool-depends: hspec-discover:hspec-discover >= 2.1 benchmark bench type: exitcode-stdio-1.0 main-is: main.hs hs-source-dirs: bench build-depends: base >= 4.7 , gauge , newtype-generics , semigroups ghc-options: -O2 default-language: Haskell2010 newtype-generics-0.5.4/test/Control/0000755000000000000000000000000007346545000015600 5ustar0000000000000000newtype-generics-0.5.4/test/Control/NewtypeSpec.hs0000644000000000000000000000321207346545000020400 0ustar0000000000000000{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} module Control.NewtypeSpec where import Prelude import Data.Monoid import Control.Newtype.Generics 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 newtype-generics-0.5.4/test/0000755000000000000000000000000007346545000014160 5ustar0000000000000000newtype-generics-0.5.4/test/main.hs0000644000000000000000000000005507346545000015440 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}