{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
module Symantic.Dityped.Permutable where

import Data.Function ((.))
import Data.Maybe (Maybe(..), fromJust)

import Symantic.Dityped.Transformable
import Symantic.Dityped.Composable
import Symantic.Dityped.Algebrable

-- * Class 'Permutable'
class Permutable repr where
  -- Use @TypeFamilyDependencies@ to help type-inference infer @(repr)@.
  type Permutation (repr:: * -> * -> *) = (r :: * -> * -> *) | r -> repr
  type Permutation repr = Permutation (Unlifted repr)
  permutable :: Permutation repr (a->k) k -> repr (a->k) k
  perm :: repr (a->k) k -> Permutation repr (a->k) k
  noPerm :: Permutation repr k k
  permWithDefault :: a -> repr (a->k) k -> Permutation repr (a->k) k
  optionalPerm ::
   Eitherable repr => Dimapable repr => Permutable repr =>
   repr (a->k) k -> Permutation repr (Maybe a -> k) k
  optionalPerm = permWithDefault Nothing . dimap Just fromJust

(<&>) ::
 Permutable repr =>
 Tupable (Permutation repr) =>
 repr (a->k) k ->
 Permutation repr (b->k) k ->
 Permutation repr ((a,b)->k) k
x <&> y = perm x <:> y

(<?&>) ::
 Eitherable repr =>
 Dimapable repr =>
 Permutable repr =>
 Tupable (Permutation repr) =>
 repr (a->k) k ->
 Permutation repr (b->k) k ->
 Permutation repr ((Maybe a,b)->k) k
x <?&> y = optionalPerm x <:> y

(<*&>) ::
 Eitherable repr =>
 Repeatable repr =>
 Dimapable repr =>
 Permutable repr =>
 Tupable (Permutation repr) =>
 repr (a->k) k ->
 Permutation repr (b->k) k ->
 Permutation repr (([a],b)->k) k
x <*&> y = permWithDefault [] (many1 x) <:> y

(<+&>) ::
 Eitherable repr =>
 Repeatable repr =>
 Dimapable repr =>
 Permutable repr =>
 Tupable (Permutation repr) =>
 repr (a->k) k ->
 Permutation repr (b->k) k ->
 Permutation repr (([a],b)->k) k
x <+&> y = perm (many1 x) <:> y

infixr 4 <&>
infixr 4 <?&>
infixr 4 <*&>
infixr 4 <+&>

{-# INLINE (<&>)  #-}
{-# INLINE (<?&>) #-}
{-# INLINE (<*&>) #-}
{-# INLINE (<+&>) #-}