{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}

-- | 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'.
module Distribution.Compat.Newtype
  ( Newtype (..)
  , ala
  , alaf
  , pack'
  , unpack'
  ) where

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

-- | The @FunctionalDependencies@ version of 'Newtype' type-class.
--
-- Since Cabal-3.0 class arguments are in a different order than in @newtype@ package.
-- This change is to allow usage with @DeriveAnyClass@ (and @DerivingStrategies@, in GHC-8.2).
-- Unfortunately one has to repeat inner type.
--
-- @
-- newtype New = New Old
--   deriving anyclass (Newtype Old)
-- @
--
-- Another approach would be to use @TypeFamilies@ (and possibly
-- compute inner type using "GHC.Generics"), but we think @FunctionalDependencies@
-- version gives cleaner type signatures.
{- FOURMOLU_DISABLE -}
class Newtype o n | n -> o where
  pack :: o -> n
  default pack :: Coercible o n => o -> n
  pack = o -> n
forall a b. Coercible a b => a -> b
coerce

  unpack :: n -> o
  default unpack :: Coercible n o => n -> o
  unpack = n -> o
forall a b. Coercible a b => a -> b
coerce
{- FOURMOLU_ENABLE -}

instance Newtype a (Identity a)
instance Newtype a (Sum a)
instance Newtype a (Product a)
instance Newtype (a -> a) (Endo a)

-- |
--
-- >>> 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 o n, Newtype o' n') => (o -> n) -> ((o -> n) -> b -> n') -> (b -> o')
ala :: forall o n o' n' b.
(Newtype o n, Newtype o' n') =>
(o -> n) -> ((o -> n) -> b -> n') -> b -> o'
ala o -> n
pa (o -> n) -> b -> n'
hof = (o -> n) -> ((o -> n) -> b -> n') -> (o -> o) -> b -> o'
forall o n o' n' a b.
(Newtype o n, Newtype o' n') =>
(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 o n, Newtype o' n') => (o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> (b -> o')
alaf :: forall o n o' n' a b.
(Newtype o n, Newtype o' n') =>
(o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> b -> o'
alaf o -> n
_ (a -> n) -> b -> n'
hof a -> o
f = n' -> o'
forall o n. Newtype o n => 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 o n. Newtype o n => 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 o n => (o -> n) -> o -> n
pack' :: forall o n. Newtype o n => (o -> n) -> o -> n
pack' o -> n
_ = o -> n
forall o n. Newtype o n => o -> n
pack

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