{-# LANGUAGE PolyKinds     #-}
{-# LANGUAGE RankNTypes    #-}
{-# LANGUAGE TypeOperators #-}

{-# OPTIONS_GHC -Wall -Wno-name-shadowing #-}

module Data.ITraversable
    ( ITraversable (..)
    , imapDefault
    -- * Re-exports
    , module Data.IFunctor
    ) where

import           Data.Functor.Identity (Identity (Identity, runIdentity))
import           Data.Functor.Product  (Product (Pair))
import           Data.Functor.Sum      (Sum (InL, InR))
import           Data.IFunctor
import           Singlethongs          (SingI)

class IFunctor f => ITraversable f where
    itraverse :: (Applicative m, SingI ix)
              => (forall ix. SingI ix => a ix -> m (b ix))
              -> f a ix
              -> m (f b ix)

-- | Default 'imap' for deriving 'IFunctor'
imapDefault :: ITraversable f
            => (a ~~> b)
            -> (f a ~~> f b)
imapDefault :: (a ~~> b) -> f a ~~> f b
imapDefault f :: a ~~> b
f = Identity (f b ix) -> f b ix
forall a. Identity a -> a
runIdentity (Identity (f b ix) -> f b ix)
-> (f a ix -> Identity (f b ix)) -> f a ix -> f b ix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (ix :: k). SingI ix => a ix -> Identity (b ix))
-> f a ix -> Identity (f b ix)
forall k k (f :: (k -> *) -> k -> *) (m :: * -> *) (ix :: k)
       (a :: k -> *) (b :: k -> *).
(ITraversable f, Applicative m, SingI ix) =>
(forall (ix :: k). SingI ix => a ix -> m (b ix))
-> f a ix -> m (f b ix)
itraverse (b ix -> Identity (b ix)
forall a. a -> Identity a
Identity (b ix -> Identity (b ix))
-> (a ix -> b ix) -> a ix -> Identity (b ix)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a ix -> b ix
a ~~> b
f)

instance ITraversable (Sum a) where
    itraverse :: (forall (ix :: k). SingI ix => a ix -> m (b ix))
-> Sum a a ix -> m (Sum a b ix)
itraverse _ (InL x :: a ix
x) = Sum a b ix -> m (Sum a b ix)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sum a b ix -> m (Sum a b ix)) -> Sum a b ix -> m (Sum a b ix)
forall a b. (a -> b) -> a -> b
$ a ix -> Sum a b ix
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL a ix
x
    itraverse f :: forall (ix :: k). SingI ix => a ix -> m (b ix)
f (InR x :: a ix
x) = b ix -> Sum a b ix
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (b ix -> Sum a b ix) -> m (b ix) -> m (Sum a b ix)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a ix -> m (b ix)
forall (ix :: k). SingI ix => a ix -> m (b ix)
f a ix
x

instance ITraversable (Product a) where
    itraverse :: (forall (ix :: k). SingI ix => a ix -> m (b ix))
-> Product a a ix -> m (Product a b ix)
itraverse f :: forall (ix :: k). SingI ix => a ix -> m (b ix)
f (Pair a :: a ix
a b :: a ix
b) = a ix -> b ix -> Product a b ix
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair a ix
a (b ix -> Product a b ix) -> m (b ix) -> m (Product a b ix)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a ix -> m (b ix)
forall (ix :: k). SingI ix => a ix -> m (b ix)
f a ix
b