{-# OPTIONS_HADDOCK hide #-}
{-# OPTIONS -Wno-orphans #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Control.Functor.Linear.Internal.Instances
  ( Data(..)
  ) where

import Prelude.Linear.Internal
import Control.Functor.Linear.Internal.Class
import qualified Data.Functor.Linear.Internal.Functor as Data
import qualified Data.Functor.Linear.Internal.Applicative as Data
import Data.Monoid.Linear hiding (Sum)
import Data.Functor.Sum
import Data.Functor.Compose
import Data.Functor.Identity


-- # Deriving Data.XXX in terms of Control.XXX
-------------------------------------------------------------------------------

-- | This is a newtype for deriving Data.XXX classes from
-- Control.XXX classes.
newtype Data f a = Data (f a)


-- # Basic instances
-------------------------------------------------------------------------------

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

instance Applicative f => Data.Applicative (Data f) where
  pure :: forall a. a -> Data f a
pure a
x = f a -> Data f a
forall (f :: * -> *) a. f a -> Data f a
Data (a %1 -> f a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure a
x)
  Data f (a %1 -> b)
f <*> :: forall a b. Data f (a %1 -> b) %1 -> Data f a %1 -> Data f b
<*> Data f a
x = f b %1 -> Data f b
forall (f :: * -> *) a. f a -> Data f a
Data (f (a %1 -> b)
f f (a %1 -> b) %1 -> f a %1 -> f b
forall (f :: * -> *) a b.
Applicative f =>
f (a %1 -> b) %1 -> f a %1 -> f b
<*> f a
x)

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

instance Monoid a => Applicative ((,) a) where
  pure :: forall a. a %1 -> (a, a)
pure a
x = (a
forall a. Monoid a => a
mempty, a
x)
  (a
a, a %1 -> b
f) <*> :: forall a b. (a, a %1 -> b) %1 -> (a, a) %1 -> (a, b)
<*> (a
b, a
x) = (a
a a %1 -> a %1 -> a
forall a. Semigroup a => a %1 -> a %1 -> a
<> a
b, a %1 -> b
f a
x)

instance Monoid a => Monad ((,) a) where
  (a
a, a
x) >>= :: forall a b. (a, a) %1 -> (a %1 -> (a, b)) %1 -> (a, b)
>>= a %1 -> (a, b)
f = a %1 -> (a, b) %1 -> (a, b)
forall b. a %1 -> (a, b) %1 -> (a, b)
go a
a (a %1 -> (a, b)
f a
x)
    where go :: a %1-> (a,b) %1-> (a,b)
          go :: forall b. a %1 -> (a, b) %1 -> (a, b)
go a
b1 (a
b2, b
y) = (a
b1 a %1 -> a %1 -> a
forall a. Semigroup a => a %1 -> a %1 -> a
<> a
b2, b
y)

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

instance Applicative Identity where
  pure :: forall a. a %1 -> Identity a
pure = a %1 -> Identity a
forall a. a -> Identity a
Identity
  Identity a %1 -> b
f <*> :: forall a b. Identity (a %1 -> b) %1 -> Identity a %1 -> Identity b
<*> Identity a
x = b %1 -> Identity b
forall a. a -> Identity a
Identity (a %1 -> b
f a
x)

instance Monad Identity where
  Identity a
x >>= :: forall a b. Identity a %1 -> (a %1 -> Identity b) %1 -> Identity b
>>= a %1 -> Identity b
f = a %1 -> Identity b
f a
x

instance (Functor f, Functor g) => Functor (Sum f g) where
  fmap :: forall a b. (a %1 -> b) %1 -> Sum f g a %1 -> Sum f g b
fmap a %1 -> b
f (InL f a
fa) = f b %1 -> Sum f g b
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL ((a %1 -> b) %1 -> f a %1 -> f b
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
fmap a %1 -> b
f f a
fa)
  fmap a %1 -> b
f (InR g a
ga) = g b %1 -> Sum f g b
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR ((a %1 -> b) %1 -> g a %1 -> g b
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> 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) %1 -> Compose f g a %1 -> Compose f g b
fmap a %1 -> b
f (Compose f (g a)
fga) = f (g b) %1 -> Compose f g b
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g b) %1 -> Compose f g b) %1 -> f (g b) %1 -> Compose f g b
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (g a %1 -> g b) %1 -> f (g a) %1 -> f (g b)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
fmap ((a %1 -> b) %1 -> g a %1 -> g b
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
fmap a %1 -> b
f) f (g a)
fga