General 'typeless' STack in Haskell

Question

I need to implement a general stack for something I'm working on. This stack should be able to hold elements of different types. For example, (1, 'c', True, "Strings"). The functions to be supported are top, pop and push.

Tuples are the most natural idea for this.

push x s = (x,s)
pop s = snd s
top s = (fst s, s)

But I need to support the empty stack too. Here, pop and top are not defined on (). So I tried creating a new type.

data Stack = Empty | forall x. Cons (x, Stack)
push x s = Cons (x,s)
pop s = case s of
        Empty -> Left s
        Cons (x, y) -> Right y
top s = case s of
        Empty -> (Left (), s)
        Cons (x,y) -> (Right x, s)

Here, top gives me an error:

Couldn't match expected type ‘b’ with actual type ‘x’
  because type variable ‘x’ would escape its scope
This (rigid, skolem) type variable is bound by
  a pattern with constructor
    Cons :: forall x. (x, Stack) -> Stack,
  in a case alternative
  at try.hs:11:9-18
Relevant bindings include
  x :: x (bound at try.hs:11:15)
  top :: Stack -> (Either () b, Stack) (bound at try.hs:9:1)
In the first argument of ‘Right’, namely ‘x’
In the expression: Right x

If I work around this with:

data Stack x = Empty | forall y. Cons (x, Stack y)

I get the same error for pop.

I also tried adding this:

type AnyStack = forall x. Stack x

but again get a similar error:

Couldn't match expected type ‘b’ with actual type ‘Stack y’
  because type variable ‘y’ would escape its scope
This (rigid, skolem) type variable is bound by
  a pattern with constructor
    Cons :: forall x y. (x, Stack y) -> Stack x,
  in a case alternative
  at try.hs:8:9-19
Relevant bindings include
  y :: Stack y (bound at try.hs:8:18)
  pop :: Stack t -> Either (Stack t) b (bound at try.hs:6:1)
In the first argument of ‘Right’, namely ‘y’
In the expression: Right y

Could anyone help me out with the right type signatures or type definition for this kind of a stack? Or maybe point me to some good reference related to this?

Thanks a lot in advanced!

Edit:

It'd be perfect if I'd also be able to include a get function for this stack. Given an integer i, and a stack s, get would return the i-th element of s. I was hoping that probably I'd be able to do that myself once push, pop and top are sorted out, but I'm still unable to. Any ideas regarding this guys?

Answer 1

Do you need to have it untyped? If you're willing to use advanced GHC features, you can do something like this:

{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeOperators #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}

module Stack (Stack(..), push, pop, top, empty) where

data Stack (h :: [*]) where
    Empty :: Stack '[]
    Push :: x -> Stack xs -> Stack (x ': xs)

instance Show (Stack '[]) where
    showsPrec d Empty = showParen (d > 11) $ showString "Empty"

instance (Show x, Show (Stack xs)) => Show (Stack (x ': xs)) where
    showsPrec d (Push x xs) = showParen (d > 10) $
        showString "Push " . showsPrec 11 x . showChar ' ' . showsPrec 11 xs

instance Eq (Stack '[]) where
    _ == _ = True

instance (Eq x, Eq (Stack xs)) => Eq (Stack (x ': xs)) where
    (Push x xs) == (Push y ys) = x == y && xs == ys

instance Ord (Stack '[]) where
    compare _ _ = EQ

instance (Ord x, Ord (Stack xs)) => Ord (Stack (x ': xs)) where
    compare (Push x xs) (Push y ys) = case compare x y of
    EQ -> compare xs ys
    LT -> LT
    GT -> GT


push :: x -> Stack xs -> Stack (x ': xs)
push = Push

pop :: Stack (x ': xs) -> Stack xs
pop (Push _ xs) = xs

top :: Stack (x ': xs) -> x
top (Push x _) = x

empty :: Stack '[]
empty = Empty

A few uses in ghci look like this:

[1 of 1] Compiling Stack            ( typelist.hs, interpreted )
Ok, modules loaded: Stack.
*Stack> :t push True . push (Just 'X') . push 5 . push "nil" $ empty
push True . push (Just 'X') . push 5 . push "nil" $ empty
  :: Num x => Stack '[Bool, Maybe Char, x, [Char]]
*Stack> push True . push (Just 'X') . push 5 . push "nil" $ empty
Push True (Push (Just 'X') (Push 5 (Push "nil" Empty)))
*Stack> pop . push True . push (Just 'X') . push 5 . push "nil" $ empty
Push (Just 'X') (Push 5 (Push "nil" Empty))
*Stack> pop empty

<interactive>:75:5:
    Couldn't match type ‘'[]’ with ‘x0 : xs’
    Expected type: Stack (x0 : xs)
      Actual type: Stack '[]
    Relevant bindings include
      it :: Stack xs (bound at <interactive>:75:1)
    In the first argument of ‘pop’, namely ‘empty’
    In the expression: pop empty

Note that this representation has the nice feature that it's a compile-time error to call pop or top on an empty stack. It is slightly harder to work with, though, since you always need to prove you're calling it with a non-empty stack. It's good for preventing bugs, but sometimes requires more bookkeeping to convince the compiler you got it right. It's not a sure thing that this representation is a good choice. It depends on the use case.

Answer 2

You shouldn't be able to define pop on the empty tuple, but the rest is smooth enough if we use a type class to represent cases on the type of the stack.

class Stack h where
  push :: a -> h x -> h (a, x)
  pop :: h (a, x) -> (h x, a)
  top :: h (a, x) -> (h (a, x), a)
  top hax = let (_, a) = pop hax in (hax, a)

newtype S x = S x

instance Stack S where
  push a (S x) = S (a, x)
  pop (S (a, x)) = (S x, a)

If you expose push/pop/top and S abstractly along with

sempty :: S ()
sempty = S ()

You can ensure that nobody can build pathological stacks. If you're alright with GADTs then there are nicer encodings.

data S h where
  Nil :: S ()
  Cons :: a -> S x -> S (a, x)

You can expose this GADT directly as it already cannot have a type violation.

instance Stack S where
  push = Cons
  pop (Cons a x) = (x, a)