{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
-- | 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'.
module Distribution.Compat.Newtype (
    Newtype (..),
    ala,
    alaf,
    pack',
    unpack',
    ) where

import Data.Functor.Identity (Identity (..))
import Data.Monoid (Sum (..), Product (..), Endo (..))

-- | The @FunctionalDependencies@ version of 'Newtype' type-class.
--
-- /Note:/ for actual newtypes the implementation can be
-- @pack = coerce; unpack = coerce@. We don't have default implementation,
-- because @Cabal@ have to support older than @base >= 4.7@ compilers.
-- Also, 'Newtype' could witness a non-structural isomorphism.
class Newtype n o | n -> o where
    pack   :: o -> n
    unpack :: n -> o

instance Newtype (Identity a) a where
    pack :: a -> Identity a
pack   = a -> Identity a
forall a. a -> Identity a
Identity
    unpack :: Identity a -> a
unpack = Identity a -> a
forall a. Identity a -> a
runIdentity

instance Newtype (Sum a) a where
    pack :: a -> Sum a
pack   = a -> Sum a
forall a. a -> Sum a
Sum
    unpack :: Sum a -> a
unpack = Sum a -> a
forall a. Sum a -> a
getSum

instance Newtype (Product a) a where
    pack :: a -> Product a
pack   = a -> Product a
forall a. a -> Product a
Product
    unpack :: Product a -> a
unpack = Product a -> a
forall a. Product a -> a
getProduct

instance Newtype (Endo a) (a -> a) where
    pack :: (a -> a) -> Endo a
pack   = (a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Endo
    unpack :: Endo a -> a -> a
unpack = Endo a -> a -> a
forall a. Endo a -> a -> a
appEndo

-- |
--
-- >>> ala Sum foldMap [1, 2, 3, 4 :: Int]
-- 10
--
-- /Note:/ the user supplied function for the newtype is /ignored/.
--
-- >>> ala (Sum . (+1)) foldMap [1, 2, 3, 4 :: Int]
-- 10
ala :: (Newtype n o, Newtype n' o') => (o -> n) -> ((o -> n) -> b -> n') -> (b -> o')
ala :: (o -> n) -> ((o -> n) -> b -> n') -> b -> o'
ala pa :: o -> n
pa hof :: (o -> n) -> b -> n'
hof = (o -> n) -> ((o -> n) -> b -> n') -> (o -> o) -> b -> o'
forall n o n' o' a b.
(Newtype n o, Newtype n' o') =>
(o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> b -> o'
alaf o -> n
pa (o -> n) -> b -> n'
hof o -> o
forall a. a -> a
id

-- |
--
-- >>> alaf Sum foldMap length ["cabal", "install"]
-- 12
--
-- /Note:/ as with 'ala', the user supplied function for the newtype is /ignored/.
alaf :: (Newtype n o, Newtype n' o') => (o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> (b -> o')
alaf :: (o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> b -> o'
alaf _ hof :: (a -> n) -> b -> n'
hof f :: a -> o
f = n' -> o'
forall n o. Newtype n o => n -> o
unpack (n' -> o') -> (b -> n') -> b -> o'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> n) -> b -> n'
hof (o -> n
forall n o. Newtype n o => o -> n
pack (o -> n) -> (a -> o) -> a -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> o
f)

-- | Variant of 'pack', which takes a phantom type.
pack' :: Newtype n o => (o -> n) -> o -> n
pack' :: (o -> n) -> o -> n
pack' _ = o -> n
forall n o. Newtype n o => o -> n
pack

-- | Variant of 'pack', which takes a phantom type.
unpack' :: Newtype n o => (o -> n) -> n -> o
unpack' :: (o -> n) -> n -> o
unpack' _ = n -> o
forall n o. Newtype n o => n -> o
unpack