content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE DerivingVia #-}
  {-# LANGUAGE EmptyCase #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE LinearTypes #-}
  {-# LANGUAGE PolyKinds #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE StandaloneDeriving #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE UndecidableInstances #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  {-# OPTIONS_HADDOCK hide #-}
  
  module Data.Unrestricted.Linear.Internal.Dupable
    ( Dupable (..),
      genericDupR,
      dup,
      dup3,
      dup4,
      dup5,
      dup6,
      dup7,
      GDupable,
    )
  where
  
  import Data.List.NonEmpty (NonEmpty)
  import Data.Replicator.Linear.Internal (Replicator (..))
  import qualified Data.Replicator.Linear.Internal as Replicator
  import Data.Replicator.Linear.Internal.ReplicationStream (ReplicationStream (..))
  import qualified Data.Replicator.Linear.Internal.ReplicationStream as ReplicationStream
  import qualified Data.Semigroup as Semigroup
  import Data.Unrestricted.Linear.Internal.Consumable
  import Data.Unrestricted.Linear.Internal.Ur (Ur)
  import GHC.Tuple (Solo (..))
  import GHC.Types (Multiplicity (..))
  import Prelude.Linear.Generically
  import Prelude.Linear.Internal
  import qualified Unsafe.Linear as Unsafe
  import qualified Prelude
  
  -- | The laws of 'Dupable' are dual to those of 'Monoid':
  --
  -- * 1. @first consume (dup2 a) ≃ a ≃ second consume (dup2 a)@ ('dup2' neutrality)
  -- * 2. @first dup2 (dup2 a) ≃ (second dup2 (dup2 a))@ ('dup2' associativity)
  --
  -- where the @(≃)@ sign represents equality up to type isomorphism.
  --
  -- * 3. @dup2 = Replicator.elim (,) . dupR@ (coherence between 'dup2' and 'dupR')
  -- * 4. @consume = Replicator.elim () . dupR@ (coherence between 'consume' and 'dupR')
  --
  -- * 5. @Replicator.extract . dupR = id@ ('dupR' identity)
  -- * 6. @dupR . dupR = (Replicator.map dupR) . dupR@ ('dupR' interchange)
  --
  -- (Laws 1-2 and 5-6 are equivalent)
  --
  -- Implementation of 'Dupable' for 'Data.Unrestricted.Movable' types should
  -- be done with @deriving via 'Data.Unrestricted.AsMovable'@.
  --
  -- Implementation of 'Dupable' for other types can be done with
  -- @deriving via 'Generically'@. Note that at present this mechanism
  -- can have performance problems for recursive parameterized types.
  -- Specifically, the methods will not specialize to underlying 'Dupable'
  -- instances. See [this GHC issue](https://gitlab.haskell.org/ghc/ghc/-/issues/21131).
  class (Consumable a) => Dupable a where
    {-# MINIMAL dupR | dup2 #-}
  
    -- | Creates a 'Replicator' for the given @a@.
    --
    -- You usually want to define this method using 'Replicator'\'s
    -- 'Data.Functor.Linear.Applicative' instance. For instance, here is an
    -- implementation of @'Dupable' [a]@:
    --
    -- > instance Dupable a => Dupable [a] where
    -- >   dupR [] = pure []
    -- >   dupR (a : as) = (:) <$> dupR a <*> dupR as
    dupR :: a %1 -> Replicator a
    dupR x = Streamed $ ReplicationStream x id dup2 consume
  
    -- | Creates two @a@s from a @'Dupable' a@, in a linear fashion.
    dup2 :: a %1 -> (a, a)
    dup2 x = Replicator.elim (,) (dupR x)
  
  -- | Creates 3 @a@s from a @'Dupable' a@, in a linear fashion.
  dup3 :: (Dupable a) => a %1 -> (a, a, a)
  dup3 x = Replicator.elim (,,) (dupR x)
  
  -- | Creates 4 @a@s from a @'Dupable' a@, in a linear fashion.
  dup4 :: (Dupable a) => a %1 -> (a, a, a, a)
  dup4 x = Replicator.elim (,,,) (dupR x)
  
  -- | Creates 5 @a@s from a @'Dupable' a@, in a linear fashion.
  dup5 :: (Dupable a) => a %1 -> (a, a, a, a, a)
  dup5 x = Replicator.elim (,,,,) (dupR x)
  
  -- | Creates 6 @a@s from a @'Dupable' a@, in a linear fashion.
  dup6 :: (Dupable a) => a %1 -> (a, a, a, a, a, a)
  dup6 x = Replicator.elim (,,,,,) (dupR x)
  
  -- | Creates 7 @a@s from a @'Dupable' a@, in a linear fashion.
  dup7 :: (Dupable a) => a %1 -> (a, a, a, a, a, a, a)
  dup7 x = Replicator.elim (,,,,,,) (dupR x)
  
  -- | Creates two @a@s from a @'Dupable' a@. Same function as 'dup2'.
  dup :: (Dupable a) => a %1 -> (a, a)
  dup = dup2
  
  ------------
  -- Instances
  ------------
  
  instance Dupable (ReplicationStream a) where
    dupR = Streamed . ReplicationStream.duplicate
  
  instance Dupable (Replicator a) where
    dupR = Replicator.duplicate
  
  deriving via
    Generically Prelude.Bool
    instance
      Dupable Prelude.Bool
  
  deriving via
    Generically Prelude.Int
    instance
      Dupable Prelude.Int
  
  deriving via
    Generically Prelude.Word
    instance
      Dupable Prelude.Word
  
  deriving via
    Generically Prelude.Ordering
    instance
      Dupable Prelude.Ordering
  
  deriving via
    Generically Prelude.Char
    instance
      Dupable Prelude.Char
  
  deriving via
    Generically Prelude.Double
    instance
      Dupable Prelude.Double
  
  deriving via
    Generically Prelude.Float
    instance
      Dupable Prelude.Float
  
  deriving via
    Generically (Prelude.Maybe a)
    instance
      (Dupable a) => Dupable (Prelude.Maybe a)
  
  deriving via
    Generically (Prelude.Either a b)
    instance
      (Dupable a, Dupable b) => Dupable (Prelude.Either a b)
  
  -- This instance is written manually because I (David Feuer) haven't
  -- been able to find a way to get the generic version to specialize
  -- to a particular underlying Dupable. The recursion leads to the
  -- whole thing being a loop breaker and I don't know how to fix that.
  instance (Dupable a) => Dupable [a] where
    dupR = go
      where
        go :: [a] %1 -> Replicator [a]
        go [] = Replicator.pure []
        go (x : xs) = Replicator.liftA2 (:) (dupR x) (go xs)
  
  deriving via
    Generically (NonEmpty a)
    instance
      (Dupable a) => Dupable (NonEmpty a)
  
  deriving via
    Generically (Ur a)
    instance
      Dupable (Ur a)
  
  deriving via
    Generically ()
    instance
      Dupable ()
  
  deriving via
    Generically (Solo a)
    instance
      (Dupable a) => Dupable (Solo a)
  
  deriving via
    Generically (a, b)
    instance
      (Dupable a, Dupable b) => Dupable (a, b)
  
  deriving via
    Generically (a, b, c)
    instance
      (Dupable a, Dupable b, Dupable c) => Dupable (a, b, c)
  
  deriving via
    Generically (a, b, c, d)
    instance
      (Dupable a, Dupable b, Dupable c, Dupable d) => Dupable (a, b, c, d)
  
  deriving via
    Generically (a, b, c, d, e)
    instance
      (Dupable a, Dupable b, Dupable c, Dupable d, Dupable e) => Dupable (a, b, c, d, e)
  
  deriving newtype instance (Dupable a) => Dupable (Semigroup.Sum a)
  
  deriving newtype instance (Dupable a) => Dupable (Semigroup.Product a)
  
  deriving newtype instance Dupable Semigroup.All
  
  deriving newtype instance Dupable Semigroup.Any
  
  -------------------
  -- Generic deriving
  -------------------
  
  instance (Generic a, GDupable (Rep a)) => Dupable (Generically a) where
    dupR (Generically x) = lcoerce (Replicator.map (to :: Rep a x %1 -> a) (gdupR (from x)))
  
  genericDupR :: (Generic a, GDupable (Rep a)) => a %1 -> Replicator a
  genericDupR x = Replicator.map to (gdupR (from x))
  
  class (GConsumable f) => GDupable f where
    gdupR :: f a %1 -> Replicator (f a)
  
  instance (GDupable f) => GDupable (M1 i c f) where
    gdupR (M1 x) = lcoerce (gdupR x)
    {-# INLINE gdupR #-}
  
  instance (GDupable f, GDupable g) => GDupable (f :*: g) where
    gdupR (x :*: y) = Replicator.liftA2 (:*:) (gdupR x) (gdupR y)
    {-# INLINE gdupR #-}
  
  instance (GDupable f, GDupable g) => GDupable (f :+: g) where
    gdupR (L1 x) = Replicator.map L1 (gdupR x)
    gdupR (R1 y) = Replicator.map R1 (gdupR y)
    {-# INLINE gdupR #-}
  
  instance (Dupable c) => GDupable (K1 i c) where
    gdupR = lcoerce (dupR @c)
    {-# INLINE gdupR #-}
  
  instance GDupable U1 where
    gdupR U1 = Replicator.pure U1
    {-# INLINE gdupR #-}
  
  instance GDupable V1 where
    gdupR = \case {}
    {-# INLINE gdupR #-}
  
  instance GDupable (MP1 'Many f) where
    gdupR (MP1 x) = Replicator.pure (MP1 x)
    {-# INLINE gdupR #-}
  
  instance (GDupable f) => GDupable (MP1 'One f) where
    gdupR (MP1 x) = Replicator.map MP1 (gdupR x)
    {-# INLINE gdupR #-}
  
  instance GDupable UChar where
    gdupR = Unsafe.toLinear Replicator.pure
  
  instance GDupable UDouble where
    gdupR = Unsafe.toLinear Replicator.pure
  
  instance GDupable UFloat where
    gdupR = Unsafe.toLinear Replicator.pure
  
  instance GDupable UInt where
    gdupR = Unsafe.toLinear Replicator.pure
  
  instance GDupable UWord where
    gdupR = Unsafe.toLinear Replicator.pure
  