A non-regular data type challenge

<a href="http://twan.home.fmf.nl/code/blog/haskell/non-regular1.lhs" style="color:grey;font-size:smaller;">[This post is literate Haskell, download source code here]</a>

While playing around with generalized functional references I encountered the following list-like data type:

> -- IGNORE
> {-# LANGUAGE ExistentialQuantification #-}
> import Control.Applicative

> data FunList a b
>     = Done b
>     | More a (FunList a (a -> b))

This is a non-regular data type, meaning that inside the @FunList a b@ there is a @FunList a !!!<i>not-b</i>!!!@. So, what does a value of this type look like? Well, it can be
* @Done (x :: b)@, or
* @More a__1 (Done (x :: a -> b))@, or
* @More a__1 (More a__2 (Done (x :: a -> a -> b)))@, etc.
We either have just @b@, or an @a@ and a function @a->b@, or two @a@s (i.e. @a@$^2$) and a function @a!!!<sup>2</sup>!!!->b@, or @a@$^3$ and @a!!!<sup>3</sup>!!!->b@, etc.

A @FunList a b@ is therefore a list of @a@s together with a function that takes ''exactly'' that number of @a@s to give you a @b@.
Extracting the single represented @b@ value is easy:

> getB :: FunList a b -> b
> getB (Done b)   = b
> getB (More a z) = getB z a

As is getting to the list of @a@s:

> getAs :: FunList a b -> [a] 
> getAs (Done _)   = []
> getAs (More a z) = a : getAs z

But then things quickly get much trickier.
Since a @FunList a b@ holds exactly one @b@, we might ask how much access we have to it.
First of, @FunList a@ is a Functor, so the @b@ value can be changed:

> instance Functor (FunList a) where
>     fmap f (Done b)   = Done (f b)
>     fmap f (More a z) = More a (fmap (f .) z)

The above case for @More@ looks a bit strange, but remember that the data type is non-regular, so we recurse with a different function @f@. In this case instead of having type @b -> c@ as the outer @f@ does, we need something with type @(a -> b) -> (a -> c)@.

The @Applicative@ instance is even stranger. There is a @flip@ there, where the heck did that come from?

> instance Applicative (FunList a) where
>     pure = Done
>     Done b   <*> c = fmap b c                    -- follows from Applicative laws
>     More a z <*> c = More a (flip <$> z <*> c)   -- flip??

Aside from manipulating the @b@ value we can also do more list like things to the list of @a@s, such as zipping:
 
> zipFun :: FunList a b -> FunList c d -> FunList (a,c) (b,d)
> zipFun (Done b)   d          = Done (b,getB d)
> zipFun b          (Done d)   = Done (getB b,d)
> zipFun (More a b) (More c d) = More (a,c) (applyPair <$> zipFun b d)
>     where applyPair (f,g) (x,y) = (f x,g y)

Surprisingly, the applicative operator defined above can be used as a kind of append, just look at the type:
] (<*>) :: FunList a (b -> c) -> FunList a b -> FunList a c
it takes two 'lists' and combines them into one. It is indeed true that @getAs a ++ getAs b == getAs (a <*> b)@.


This is as far as I got, so I will end this post with a couple of challenges:
* Show that @FunList a@ is a monad.
* Show that @FunList a@ is not a monad.
* Write a function @reverseFun :: FunList a b -> FunList a b@ that reverses a FunList, i.e. @getAs . reverseFun == reverse . getAs@.
* Write a $O(n)$ reverse function.

> -- IGNORE
> -- here is a O(n^2) reverse function
> 
> -- snocFun x a == x <*> A a (B id)
> snocFun :: FunList a (a -> b) -> a -> FunList a b
> snocFun (Done b)   z = More z (Done b)
> snocFun (More a f) z = More a (snocFun f z)
> 
> reverseFun :: FunList a b -> FunList a b
> reverseFun (Done b)   = (Done b)
> reverseFun (More a z) = reverseFun z `snocFun` a

> -- IGNORE
> -- for the existential version everything seems to work without change:
> 
> data FunList2 b = Done2 b | forall a. More2 a (FunList2 (a -> b))
> 
> instance Functor FunList2 where
>     fmap f (Done2 b)   = Done2 (f b)
>     fmap f (More2 a z) = More2 a (fmap (f .) z)
> 
> instance Applicative FunList2 where
>     pure = Done2
>     Done2 b   <*> c = fmap b c
>     More2 a z <*> c = More2 a (flip <$> z <*> c)
> 
> getB2 :: FunList2 b -> b
> getB2 (Done2 b)   = b
> getB2 (More2 a z) = getB2 z a
> 
> zipFun2 :: FunList2 b -> FunList2 d -> FunList2 (b,d)
> zipFun2 (Done2 b)   d           = Done2 (b,getB2 d)
> zipFun2 b           (Done2 d)   = Done2 (getB2 b,d)
> zipFun2 (More2 a b) (More2 c d) = More2 (a,c) (applyPair <$> zipFun2 b d)
>     where applyPair (f,g) (x,y) = (f x,g y)
> 
> -- obviously getAs and reverseFun will not work here