Sequence implementation using Monoid

Seq.hs

-- http://apfelmus.nfshost.com/articles/monoid-fingertree.html
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

import Prelude hiding ((!!), head)
import Data.Monoid

data Tree v a = Leaf   v a
              | Branch v (Tree v a) (Tree v a)

class Monoid v => Measured a v where
    measure :: a -> v

toList :: Tree v a -> [a]
toList (Leaf _ a)     = [a]
toList (Branch _ x y) = toList x ++ toList y

head :: Tree v a -> a
head (Leaf _ a)     = a
head (Branch _ x _) = head x

tag :: Monoid v => Tree v a -> v
tag (Leaf v _)      = v
tag (Branch _ x y)  = tag x <> tag y

leaf :: Measured a v => a -> Tree v a
leaf a = Leaf (measure a) a

branch :: Monoid v => Tree v a -> Tree v a -> Tree v a
branch x y = Branch (tag x <> tag y) x y

type Size = Int

instance Monoid Size where
  mempty = 0
  mappend = (+)

instance Measured a Size where
    measure _ = 1            -- one element = size 1

(!!) :: Tree Size a -> Int -> a
(Leaf _ a)      !! 0 = a
(Branch _ x y)  !! n 
     | n < tag x     = x !! n
     | otherwise     = y !! (n - tag x)

t :: Tree Size Int
t = branch (branch (leaf 3) (leaf 4)) (branch (leaf 2) (leaf 5))