src/Symantic/Base/Permutable.hs

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