1{-# LANGUAGE CPP #-} 2{-# LANGUAGE DefaultSignatures #-} 3{-# LANGUAGE FlexibleInstances #-} 4{-# LANGUAGE FunctionalDependencies #-} 5-- | Per Conor McBride, the 'Newtype' typeclass represents the packing and 6-- unpacking of a newtype, and allows you to operatate under that newtype with 7-- functions such as 'ala'. 8module Distribution.Compat.Newtype ( 9 Newtype (..), 10 ala, 11 alaf, 12 pack', 13 unpack', 14 ) where 15 16import Data.Functor.Identity (Identity (..)) 17import Data.Monoid (Sum (..), Product (..), Endo (..)) 18 19#if MIN_VERSION_base(4,7,0) 20import Data.Coerce (coerce, Coercible) 21#else 22import Unsafe.Coerce (unsafeCoerce) 23#endif 24 25-- | The @FunctionalDependencies@ version of 'Newtype' type-class. 26-- 27-- Since Cabal-3.0 class arguments are in a different order than in @newtype@ package. 28-- This change is to allow usage with @DeriveAnyClass@ (and @DerivingStrategies@, in GHC-8.2). 29-- Unfortunately one has to repeat inner type. 30-- 31-- @ 32-- newtype New = New Old 33-- deriving anyclass (Newtype Old) 34-- @ 35-- 36-- Another approach would be to use @TypeFamilies@ (and possibly 37-- compute inner type using "GHC.Generics"), but we think @FunctionalDependencies@ 38-- version gives cleaner type signatures. 39-- 40class Newtype o n | n -> o where 41 pack :: o -> n 42#if MIN_VERSION_base(4,7,0) 43 default pack :: Coercible o n => o -> n 44 pack = coerce 45#else 46 default pack :: o -> n 47 pack = unsafeCoerce 48#endif 49 50 unpack :: n -> o 51#if MIN_VERSION_base(4,7,0) 52 default unpack :: Coercible n o => n -> o 53 unpack = coerce 54#else 55 default unpack :: n -> o 56 unpack = unsafeCoerce 57#endif 58 59instance Newtype a (Identity a) 60instance Newtype a (Sum a) 61instance Newtype a (Product a) 62instance Newtype (a -> a) (Endo a) 63 64-- | 65-- 66-- >>> ala Sum foldMap [1, 2, 3, 4 :: Int] 67-- 10 68-- 69-- /Note:/ the user supplied function for the newtype is /ignored/. 70-- 71-- >>> ala (Sum . (+1)) foldMap [1, 2, 3, 4 :: Int] 72-- 10 73ala :: (Newtype o n, Newtype o' n') => (o -> n) -> ((o -> n) -> b -> n') -> (b -> o') 74ala pa hof = alaf pa hof id 75 76-- | 77-- 78-- >>> alaf Sum foldMap length ["cabal", "install"] 79-- 12 80-- 81-- /Note:/ as with 'ala', the user supplied function for the newtype is /ignored/. 82alaf :: (Newtype o n, Newtype o' n') => (o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> (b -> o') 83alaf _ hof f = unpack . hof (pack . f) 84 85-- | Variant of 'pack', which takes a phantom type. 86pack' :: Newtype o n => (o -> n) -> o -> n 87pack' _ = pack 88 89-- | Variant of 'unpack', which takes a phantom type. 90unpack' :: Newtype o n => (o -> n) -> n -> o 91unpack' _ = unpack 92