Tree node permutations

Perm.hs

{-# LANGUAGE GADTs #-}

data Tree a where
  OneT :: Show a => a -> Tree a
  Ap   :: (Show a, Show b) => (a -> b -> c) -> Tree a -> Tree b -> Tree c

instance Show a => Show (Tree a) where
  show (OneT a) = show a
  show (Ap _ x y) = "" ++ show x ++ "," ++ show y ++ ""

data FunList a where
  OneL :: Show a => a -> FunList a
  Cons :: (Show a, Show b) => (a -> b -> c) -> a -> FunList b -> FunList c

insertions :: (Show a, Show b, Show c) => (a -> b -> c) -> a -> FunList b -> [FunList c]
insertions f x (OneL y)      = [Cons f x (OneL y), Cons (flip f) y (OneL x)]
insertions f x (Cons g y ys) =
    Cons f x (Cons g y ys)
  : map (Cons (\a e -> f x (g a e)) y) (insertions (\_ e -> e) x ys)

permL :: Show a => FunList a -> [FunList a]
permL (OneL x)      = [OneL x]
permL (Cons f x xs) = concatMap (insertions f x) (permL xs)

apL :: (Show a, Show b, Show c) =>(a -> b -> c) -> FunList a -> FunList b -> FunList c
apL f (OneL x)      ys = Cons f x ys
apL f (Cons g x xs) ys = Cons (\a (b, c) -> f (g a b) c) x (apL (,) xs ys)

tree2List :: Show a => Tree a -> FunList a
tree2List (OneT x)   = OneL x
tree2List (Ap f l r) = apL f (tree2List l) (tree2List r)

list2Tree :: Show a => FunList a -> Tree a
list2Tree (OneL x)      = OneT x
list2Tree (Cons f x xs) = Ap f (OneT x) (list2Tree xs)

permT :: Show a => Tree a -> [Tree a]
permT = map list2Tree . permL . tree2List