# Jaguarpaw Blog - ML modules in Haskell

by Tom Ellis on 4th April 2013

The best Haskell version of The ML Module example on Wikipedia that I could manage.

``````{-# Language Rank2Types #-}

data Queue queue = Queue { empty     :: forall a. queue a
-- I'm leaving out the exception for simplicity
, isEmpty   :: forall a. queue a -> Bool
, singleton :: forall a. a -> queue a
, insert    :: forall a. (a, queue a) -> queue a
, peek      :: forall a. queue a -> a
, remove    :: forall a. queue a -> (a, queue a)
}

newtype TwoLists a = TL ([a], [a])

twolistqueue :: Queue TwoLists
twolistqueue = Queue { empty = TL ([], [])
, isEmpty = \x -> case x of TL ([], []) -> True
_           -> False
, singleton = \a -> TL ([a], [])
, insert = \(a, TL (ins, outs)) -> TL (a:ins, outs)
, peek = \x -> case x of TL ([], [])      -> undefined
TL (ins, [])     -> head (reverse ins)
TL (ins, a:outs) -> a
, remove = \x -> case x of TL ([], [])      -> undefined
TL (ins, [])     -> let newouts = reverse ins
in (head newouts, TL ([], tail newouts))
TL (ins, a:outs) -> (a, TL (ins, outs))
}

data Tree a = E | T a (Tree a) (Tree a)

(^.) :: a -> (a -> b) -> b
(^.) = flip (\$)

btfQ :: (Queue queue) -> queue (Tree a) -> [a]
btfQ qq q = if (qq^.isEmpty) q then []
else let (t, q') = (qq^.remove) q
in case t of
E -> btfQ qq q'
T x l r -> let q'' = (qq^.insert) (r, (qq^.insert) (l, q'))
in x : btfQ qq q''

bft qq t = btfQ qq ((qq^.singleton) t)``````