{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK hide #-}

module Data.Functor.Linear.Internal.Functor
  ( Functor (..),
    (<$>),
    (<$),
    void,
  )
where

import qualified Control.Monad.Trans.Cont as NonLinear
import qualified Control.Monad.Trans.Except as NonLinear
import qualified Control.Monad.Trans.Maybe as NonLinear
import qualified Control.Monad.Trans.Reader as NonLinear
import qualified Control.Monad.Trans.State.Strict as Strict
import Data.Functor.Compose
import Data.Functor.Const
import Data.Functor.Identity
import Data.Functor.Product
import Data.Functor.Sum
import Data.Kind (FUN)
import Data.Unrestricted.Linear.Internal.Consumable
import Data.Unrestricted.Linear.Internal.Ur
import GHC.Types (Multiplicity (..))
import Generics.Linear
import Prelude.Linear.Generically
import Prelude.Linear.Internal
import Prelude (Either (..), Maybe (..))

-- # Functor definition
-------------------------------------------------------------------------------

-- | Linear Data Functors should be thought of as containers holding values of
-- type @a@ over which you are able to apply a linear function of type @a %1->
-- b@ __on each__ value of type @a@ in the functor and consume a given functor
-- of type @f a@.
class Functor f where
  fmap :: (a %1 -> b) -> f a %1 -> f b

(<$>) :: (Functor f) => (a %1 -> b) -> f a %1 -> f b
<$> :: forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
(<$>) = forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap

infixl 4 <$> -- same fixity as base.<$>

-- | Replace all occurances of @b@ with the given @a@
-- and consume the functor @f b@.
(<$) :: (Functor f, Consumable b) => a -> f b %1 -> f a
a
a <$ :: forall (f :: * -> *) b a.
(Functor f, Consumable b) =>
a -> f b %1 -> f a
<$ f b
fb = forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap (forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` a
a) f b
fb

infixl 4 <$ -- same fixity as base.<$

-- | Discard a consumable value stored in a data functor.
void :: (Functor f, Consumable a) => f a %1 -> f ()
void :: forall (f :: * -> *) a. (Functor f, Consumable a) => f a %1 -> f ()
void = forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap forall a. Consumable a => a %1 -> ()
consume

-- # Instances
-------------------------------------------------------------------------------

instance Functor [] where
  fmap :: forall a b. (a %1 -> b) -> [a] %1 -> [b]
fmap (a %1 -> b
f :: a %1 -> b) = [a] %1 -> [b]
go
    where
      go :: [a] %1 -> [b]
      go :: [a] %1 -> [b]
go [] = []
      go (a
a : [a]
as) = a %1 -> b
f a
a forall a. a -> [a] -> [a]
: [a] %1 -> [b]
go [a]
as

deriving via
  Generically1 (Const x)
  instance
    Functor (Const x)

deriving via
  Generically1 Maybe
  instance
    Functor Maybe

deriving via
  Generically1 (Either e)
  instance
    Functor (Either e)

deriving via
  Generically1 ((,) a)
  instance
    Functor ((,) a)

deriving via
  Generically1 ((,,) a b)
  instance
    Functor ((,,) a b)

deriving via
  Generically1 ((,,,) a b c)
  instance
    Functor ((,,,) a b c)

deriving via
  Generically1 ((,,,,) a b c d)
  instance
    Functor ((,,,,) a b c d)

deriving via
  Generically1 Identity
  instance
    Functor Identity

instance (Functor f, Functor g) => Functor (Sum f g) where
  fmap :: forall a b. (a %1 -> b) -> Sum f g a %1 -> Sum f g b
fmap a %1 -> b
f (InL f a
fa) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f f a
fa)
  fmap a %1 -> b
f (InR g a
ga) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f g a
ga)

instance (Functor f, Functor g) => Functor (Product f g) where
  fmap :: forall a b. (a %1 -> b) -> Product f g a %1 -> Product f g b
fmap a %1 -> b
f (Pair f a
fa g a
ga) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f f a
fa) (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f g a
ga)

instance (Functor f, Functor g) => Functor (Compose f g) where
  fmap :: forall a b. (a %1 -> b) -> Compose f g a %1 -> Compose f g b
fmap a %1 -> b
f (Compose f (g a)
x) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f) f (g a)
x)

instance Functor Ur where
  fmap :: forall a b. (a %1 -> b) -> Ur a %1 -> Ur b
fmap a %1 -> b
f (Ur a
a) = forall a. a -> Ur a
Ur (a %1 -> b
f a
a)

instance Functor (FUN 'One a) where
  fmap :: forall a b. (a %1 -> b) -> (a %1 -> a) %1 -> a %1 -> b
fmap = forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
(.)

---------------------------------
-- Monad transformer instances --
---------------------------------

instance (Functor m) => Functor (NonLinear.ReaderT r m) where
  fmap :: forall a b. (a %1 -> b) -> ReaderT r m a %1 -> ReaderT r m b
fmap a %1 -> b
f (NonLinear.ReaderT r -> m a
g) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
NonLinear.ReaderT (\r
r -> forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f (r -> m a
g r
r))

-- The below transformers are all Data.Functors and all fail to be
-- Data.Applicatives without further restriction. In every case however,
-- @pure :: a -> f a@ can be defined in the standard way.
-- For @MaybeT@ and @ExceptT e@, the failure to be applicative is as detailed
-- above: @Maybe@ and @Either e@ can contain 0 or 1 elements, and so fail
-- to be applicative.
-- To give applicative instances for ContT (resp. StateT), we require the
-- parameter r (resp. s) to be Movable.

instance (Functor m) => Functor (NonLinear.MaybeT m) where
  fmap :: forall a b. (a %1 -> b) -> MaybeT m a %1 -> MaybeT m b
fmap a %1 -> b
f (NonLinear.MaybeT m (Maybe a)
x) = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
NonLinear.MaybeT forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f) m (Maybe a)
x

instance (Functor m) => Functor (NonLinear.ExceptT e m) where
  fmap :: forall a b. (a %1 -> b) -> ExceptT e m a %1 -> ExceptT e m b
fmap a %1 -> b
f (NonLinear.ExceptT m (Either e a)
x) = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
NonLinear.ExceptT forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f) m (Either e a)
x

instance Functor (NonLinear.ContT r m) where
  fmap :: forall a b. (a %1 -> b) -> ContT r m a %1 -> ContT r m b
fmap a %1 -> b
f (NonLinear.ContT (a -> m r) -> m r
x) = forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
NonLinear.ContT forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \b -> m r
k -> (a -> m r) -> m r
x (\a
a -> b -> m r
k (a %1 -> b
f a
a))

instance (Functor m) => Functor (Strict.StateT s m) where
  fmap :: forall a b. (a %1 -> b) -> StateT s m a %1 -> StateT s m b
fmap a %1 -> b
f (Strict.StateT s -> m (a, s)
x) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT (\s
s -> forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap (\(a
a, s
s') -> (a %1 -> b
f a
a, s
s')) (s -> m (a, s)
x s
s))

------------------------
-- Generics instances --
------------------------
instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where
  fmap :: forall a b. (a %1 -> b) -> Generically1 f a %1 -> Generically1 f b
fmap a %1 -> b
f = forall (f :: * -> *) a. f a -> Generically1 f a
Generically1 forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. forall {k} (f :: k -> *) (p :: k) (m :: Multiplicity).
Generic1 f =>
Rep1 f p %m -> f p
to1 forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. forall {k} (f :: k -> *) (p :: k) (m :: Multiplicity).
Generic1 f =>
f p %m -> Rep1 f p
from1 forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. forall (f :: * -> *) a. Generically1 f a %1 -> f a
unGenerically1

instance Functor U1 where
  fmap :: forall a b. (a %1 -> b) -> U1 a %1 -> U1 b
fmap a %1 -> b
_ U1 a
U1 = forall k (p :: k). U1 p
U1

instance Functor V1 where
  fmap :: forall a b. (a %1 -> b) -> V1 a %1 -> V1 b
fmap a %1 -> b
_ = \case {}

instance (Functor f, Functor g) => Functor (f :*: g) where
  fmap :: forall a b. (a %1 -> b) -> (:*:) f g a %1 -> (:*:) f g b
fmap a %1 -> b
f (f a
l :*: g a
r) = forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f f a
l forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f g a
r

instance (Functor f, Functor g) => Functor (f :+: g) where
  fmap :: forall a b. (a %1 -> b) -> (:+:) f g a %1 -> (:+:) f g b
fmap a %1 -> b
f (L1 f a
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f f a
a)
  fmap a %1 -> b
f (R1 g a
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f g a
a)

instance Functor (K1 i v) where
  fmap :: forall a b. (a %1 -> b) -> K1 i v a %1 -> K1 i v b
fmap a %1 -> b
_ (K1 v
c) = forall k i c (p :: k). c -> K1 i c p
K1 v
c

instance (Functor f) => Functor (M1 i c f) where
  fmap :: forall a b. (a %1 -> b) -> M1 i c f a %1 -> M1 i c f b
fmap a %1 -> b
f (M1 f a
a) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f f a
a)

instance Functor Par1 where
  fmap :: forall a b. (a %1 -> b) -> Par1 a %1 -> Par1 b
fmap a %1 -> b
f (Par1 a
a) = forall p. p -> Par1 p
Par1 (a %1 -> b
f a
a)

instance (Functor f, Functor g) => Functor (f :.: g) where
  fmap :: forall a b. (a %1 -> b) -> (:.:) f g a %1 -> (:.:) f g b
fmap a %1 -> b
f (Comp1 f (g a)
a) = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (x :: k1).
f (g x) -> (:.:) f g x
Comp1 (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f) f (g a)
a)

instance (Functor f) => Functor (MP1 m f) where
  fmap :: forall a b. (a %1 -> b) -> MP1 m f a %1 -> MP1 m f b
fmap a %1 -> b
f (MP1 f a
x) = forall {k} (b :: k -> *) (c :: k) (a :: Multiplicity).
b c %a -> MP1 a b c
MP1 (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
fmap a %1 -> b
f f a
x)

instance Functor UAddr where
  fmap :: forall a b. (a %1 -> b) -> UAddr a %1 -> UAddr b
fmap a %1 -> b
_ (UAddr Addr#
c) = forall k (p :: k). Addr# -> URec (Ptr ()) p
UAddr Addr#
c

instance Functor UChar where
  fmap :: forall a b. (a %1 -> b) -> UChar a %1 -> UChar b
fmap a %1 -> b
_ (UChar Char#
c) = forall k (p :: k). Char# -> URec Char p
UChar Char#
c

instance Functor UDouble where
  fmap :: forall a b. (a %1 -> b) -> UDouble a %1 -> UDouble b
fmap a %1 -> b
_ (UDouble Double#
c) = forall k (p :: k). Double# -> URec Double p
UDouble Double#
c

instance Functor UFloat where
  fmap :: forall a b. (a %1 -> b) -> UFloat a %1 -> UFloat b
fmap a %1 -> b
_ (UFloat Float#
c) = forall k (p :: k). Float# -> URec Float p
UFloat Float#
c

instance Functor UInt where
  fmap :: forall a b. (a %1 -> b) -> UInt a %1 -> UInt b
fmap a %1 -> b
_ (UInt Int#
c) = forall k (p :: k). Int# -> URec Int p
UInt Int#
c

instance Functor UWord where
  fmap :: forall a b. (a %1 -> b) -> UWord a %1 -> UWord b
fmap a %1 -> b
_ (UWord Word#
c) = forall k (p :: k). Word# -> URec Word p
UWord Word#
c