src/Symantic/Dityped/Permutable.hs

   1 {-# LANGUAGE TypeFamilyDependencies #-}
   2 {-# LANGUAGE UndecidableInstances #-}
   3 module Symantic.Dityped.Permutable where
   4
   5 import Data.Function ((.))
   6 import Data.Maybe (Maybe(..), fromJust)
   7
   8 import Symantic.Dityped.Transformable
   9 import Symantic.Dityped.Composable
  10 import Symantic.Dityped.Algebrable
  11
  12 -- * Class 'Permutable'
  13 class Permutable repr where
  14   -- Use @TypeFamilyDependencies@ to help type-inference infer @(repr)@.
  15   type Permutation (repr:: * -> * -> *) = (r :: * -> * -> *) | r -> repr
  16   type Permutation repr = Permutation (Unlifted repr)
  17   permutable :: Permutation repr (a->k) k -> repr (a->k) k
  18   perm :: repr (a->k) k -> Permutation repr (a->k) k
  19   noPerm :: Permutation repr k k
  20   permWithDefault :: a -> repr (a->k) k -> Permutation repr (a->k) k
  21   optionalPerm ::
  22    Eitherable repr => Dimapable repr => Permutable repr =>
  23    repr (a->k) k -> Permutation repr (Maybe a -> k) k
  24   optionalPerm = permWithDefault Nothing . dimap Just fromJust
  25
  26 (<&>) ::
  27  Permutable repr =>
  28  Tupable (Permutation repr) =>
  29  repr (a->k) k ->
  30  Permutation repr (b->k) k ->
  31  Permutation repr ((a,b)->k) k
  32 x <&> y = perm x <:> y
  33
  34 (<?&>) ::
  35  Eitherable repr =>
  36  Dimapable repr =>
  37  Permutable repr =>
  38  Tupable (Permutation repr) =>
  39  repr (a->k) k ->
  40  Permutation repr (b->k) k ->
  41  Permutation repr ((Maybe a,b)->k) k
  42 x <?&> y = optionalPerm x <:> y
  43
  44 (<*&>) ::
  45  Eitherable repr =>
  46  Repeatable repr =>
  47  Dimapable repr =>
  48  Permutable repr =>
  49  Tupable (Permutation repr) =>
  50  repr (a->k) k ->
  51  Permutation repr (b->k) k ->
  52  Permutation repr (([a],b)->k) k
  53 x <*&> y = permWithDefault [] (many1 x) <:> y
  54
  55 (<+&>) ::
  56  Eitherable repr =>
  57  Repeatable repr =>
  58  Dimapable repr =>
  59  Permutable repr =>
  60  Tupable (Permutation repr) =>
  61  repr (a->k) k ->
  62  Permutation repr (b->k) k ->
  63  Permutation repr (([a],b)->k) k
  64 x <+&> y = perm (many1 x) <:> y
  65
  66 infixr 4 <&>
  67 infixr 4 <?&>
  68 infixr 4 <*&>
  69 infixr 4 <+&>
  70
  71 {-# INLINE (<&>)  #-}
  72 {-# INLINE (<?&>) #-}
  73 {-# INLINE (<*&>) #-}
  74 {-# INLINE (<+&>) #-}