{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Distributive
-- Copyright   :  (C) 2011-2016 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
----------------------------------------------------------------------------
module Data.Distributive.Generic
  ( GDistributive(..)
  , genericCollect
  , genericDistribute
  ) where

import Data.Distributive
import GHC.Generics
import Data.Coerce

-- | 'collect' derived from a 'Generic1' type
--
-- This can be used to easily produce a 'Distributive' instance for a
-- type with a 'Generic1' instance,
--
-- > data V2 a = V2 a a deriving (Show, Functor, Generic1)
-- > instance Distributive V2' where collect = genericCollect
genericCollect :: (Functor f, Generic1 g, GDistributive (Rep1 g))
               => (a -> g b) -> f a -> g (f b)
genericCollect :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Generic1 g, GDistributive (Rep1 g)) =>
(a -> g b) -> f a -> g (f b)
genericCollect a -> g b
f = Rep1 g (f b) -> g (f b)
forall a. Rep1 g a -> g a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (Rep1 g (f b) -> g (f b))
-> (f a -> Rep1 g (f b)) -> f a -> g (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Rep1 g b) -> f a -> Rep1 g (f b)
forall (g :: * -> *) (f :: * -> *) a b.
(GDistributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
forall (f :: * -> *) a b.
Functor f =>
(a -> Rep1 g b) -> f a -> Rep1 g (f b)
gcollect (g b -> Rep1 g b
forall a. g a -> Rep1 g a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 (g b -> Rep1 g b) -> (a -> g b) -> a -> Rep1 g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> g b
f)

-- | 'distribute' derived from a 'Generic1' type
--
-- It's often more efficient to use 'genericCollect' instead.
genericDistribute  :: (Functor f, Generic1 g, GDistributive (Rep1 g)) => f (g a) -> g (f a)
genericDistribute :: forall (f :: * -> *) (g :: * -> *) a.
(Functor f, Generic1 g, GDistributive (Rep1 g)) =>
f (g a) -> g (f a)
genericDistribute = Rep1 g (f a) -> g (f a)
forall a. Rep1 g a -> g a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (Rep1 g (f a) -> g (f a))
-> (f (g a) -> Rep1 g (f a)) -> f (g a) -> g (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Rep1 g a) -> Rep1 g (f a)
forall (g :: * -> *) (f :: * -> *) b.
(GDistributive g, Functor f) =>
f (g b) -> g (f b)
gdistribute (f (Rep1 g a) -> Rep1 g (f a))
-> (f (g a) -> f (Rep1 g a)) -> f (g a) -> Rep1 g (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g a -> Rep1 g a) -> f (g a) -> f (Rep1 g a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g a -> Rep1 g a
forall a. g a -> Rep1 g a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1


-- Can't distribute over,
--   * sums (:+:)
--   * K1
--   * V1
class GDistributive g where
  gcollect :: Functor f => (a -> g b) -> f a -> g (f b)

gdistribute :: (GDistributive g, Functor f) => f (g b) -> g (f b)
gdistribute :: forall (g :: * -> *) (f :: * -> *) b.
(GDistributive g, Functor f) =>
f (g b) -> g (f b)
gdistribute = (g b -> g b) -> f (g b) -> g (f b)
forall (g :: * -> *) (f :: * -> *) a b.
(GDistributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
forall (f :: * -> *) a b. Functor f => (a -> g b) -> f a -> g (f b)
gcollect g b -> g b
forall a. a -> a
id
{-# INLINE gdistribute #-}

instance GDistributive U1 where
  gcollect :: forall (f :: * -> *) a b.
Functor f =>
(a -> U1 b) -> f a -> U1 (f b)
gcollect a -> U1 b
_ f a
_ = U1 (f b)
forall k (p :: k). U1 p
U1
  {-# INLINE gcollect #-}

instance (GDistributive a, GDistributive b) => GDistributive (a :*: b) where
  -- It might be tempting to fuse `gcollect fstP (fmap f x)` into
  -- `gcollect (fstP . f) x`, but this would lead to a loss of sharing.
  gcollect :: forall (f :: * -> *) a b.
Functor f =>
(a -> (:*:) a b b) -> f a -> (:*:) a b (f b)
gcollect a -> (:*:) a b b
f f a
x = ((:*:) a b b -> a b) -> f ((:*:) a b b) -> a (f b)
forall (g :: * -> *) (f :: * -> *) a b.
(GDistributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
forall (f :: * -> *) a b. Functor f => (a -> a b) -> f a -> a (f b)
gcollect (:*:) a b b -> a b
forall {f :: * -> *} {g :: * -> *} {p}. (:*:) f g p -> f p
fstP f ((:*:) a b b)
x' a (f b) -> b (f b) -> (:*:) a b (f b)
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: ((:*:) a b b -> b b) -> f ((:*:) a b b) -> b (f b)
forall (g :: * -> *) (f :: * -> *) a b.
(GDistributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
forall (f :: * -> *) a b. Functor f => (a -> b b) -> f a -> b (f b)
gcollect (:*:) a b b -> b b
forall {f :: * -> *} {g :: * -> *} {p}. (:*:) f g p -> g p
sndP f ((:*:) a b b)
x' where
    x' :: f ((:*:) a b b)
x' = (a -> (:*:) a b b) -> f a -> f ((:*:) a b b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> (:*:) a b b
f f a
x
    fstP :: (:*:) f g p -> f p
fstP (f p
l :*: g p
_) = f p
l
    sndP :: (:*:) f g p -> g p
sndP (f p
_ :*: g p
r) = g p
r
  {-# INLINE gcollect #-}

instance (Distributive a, GDistributive b) => GDistributive (a :.: b) where
  gcollect :: forall (f :: * -> *) a b.
Functor f =>
(a -> (:.:) a b b) -> f a -> (:.:) a b (f b)
gcollect a -> (:.:) a b b
f = a (b (f b)) -> (:.:) a b (f b)
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (a (b (f b)) -> (:.:) a b (f b))
-> (f a -> a (b (f b))) -> f a -> (:.:) a b (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (b b) -> b (f b)) -> a (f (b b)) -> a (b (f b))
forall a b. (a -> b) -> a a -> a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (b b) -> b (f b)
forall (g :: * -> *) (f :: * -> *) b.
(GDistributive g, Functor f) =>
f (g b) -> g (f b)
gdistribute (a (f (b b)) -> a (b (f b)))
-> (f a -> a (f (b b))) -> f a -> a (b (f b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a (b b)) -> f a -> a (f (b b))
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
forall (f :: * -> *) a b. Functor f => (a -> a b) -> f a -> a (f b)
collect ((a -> (:.:) a b b) -> a -> a (b b)
forall a b. Coercible a b => a -> b
coerce a -> (:.:) a b b
f)
  {-# INLINE gcollect #-}

instance GDistributive Par1 where
  gcollect :: forall (f :: * -> *) a b.
Functor f =>
(a -> Par1 b) -> f a -> Par1 (f b)
gcollect = ((a -> b) -> f a -> f b) -> (a -> Par1 b) -> f a -> Par1 (f b)
forall a b. Coercible a b => a -> b
coerce ((a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap :: (a -> b) -> f a -> f b)
    :: forall f a b . Functor f => (a -> Par1 b) -> f a -> Par1 (f b)
  {-# INLINE gcollect #-}

instance Distributive f => GDistributive (Rec1 f) where
  gcollect :: forall (f :: * -> *) a b.
Functor f =>
(a -> Rec1 f b) -> f a -> Rec1 f (f b)
gcollect = ((a -> f b) -> g a -> f (g b))
-> (a -> Rec1 f b) -> g a -> Rec1 f (g b)
forall a b. Coercible a b => a -> b
coerce ((a -> f b) -> g a -> f (g b)
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
forall (f :: * -> *) a b. Functor f => (a -> f b) -> f a -> f (f b)
collect :: (a -> f b) -> g a -> f (g b))
    :: forall g a b . Functor g
    => (a -> Rec1 f b) -> g a -> Rec1 f (g b)
  {-# INLINE gcollect #-}

instance GDistributive f => GDistributive (M1 i c f) where
  gcollect :: forall (f :: * -> *) a b.
Functor f =>
(a -> M1 i c f b) -> f a -> M1 i c f (f b)
gcollect = ((a -> f b) -> g a -> f (g b))
-> (a -> M1 i c f b) -> g a -> M1 i c f (g b)
forall a b. Coercible a b => a -> b
coerce ((a -> f b) -> g a -> f (g b)
forall (g :: * -> *) (f :: * -> *) a b.
(GDistributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
forall (f :: * -> *) a b. Functor f => (a -> f b) -> f a -> f (f b)
gcollect :: (a -> f b) -> g a -> f (g b))
    :: forall g a b . Functor g
    => (a -> M1 i c f b) -> g a -> M1 i c f (g b)
  {-# INLINE gcollect #-}