hw7/JoinList.hs

   1 {-# OPTIONS_GHC -Wall #-}
   2 module JoinList where
   3
   4 import Data.Monoid
   5
   6
   7 data JoinList m a = Empty
   8                   | Single m a
   9                   | Append m (JoinList m a) (JoinList m a)
  10                     deriving (Eq, Show)
  11
  12 -- exercise 1
  13 tag :: Monoid m => JoinList m a -> m
  14 tag (Empty) = mempty
  15 tag (Single t _) = t
  16 tag (Append t _ _) = t
  17
  18 (+++) :: Monoid m => JoinList m a -> JoinList m a -> JoinList m a
  19 Empty +++ x = x
  20 x +++ Empty = x
  21 alst1 +++ alst2 = Append ((tag alst1) `mappend` (tag alst2)) alst1 alst2
  22