hw7/JoinList.hs

   1 {-# OPTIONS_GHC -Wall #-}
   2 module JoinList where
   3
   4 import Data.Monoid
   5 import Sized
   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
  23 -- exercise 2
  24 -- 1. index
  25 indexJ :: (Sized b, Monoid b) =>
  26           Int -> JoinList b a -> Maybe a
  27 indexJ _ Empty = Nothing
  28 indexJ n _ | n < 0 = Nothing
  29 indexJ _ (Single _ a) = Just a
  30 indexJ n (Append _ l r) | n < (getSize (size (tag l))) = indexJ n l
  31                         | otherwise = indexJ (n - getSize (size (tag l))) r
  32
  33 -- 2. drop
  34 dropJ :: (Sized b, Monoid b) =>
  35          Int -> JoinList b a -> JoinList b a
  36 dropJ 0 x = x
  37 dropJ _ Empty = Empty
  38 dropJ _ (Single _ _) = Empty
  39 dropJ n x | (getSize (size (tag x))) < n = Empty
  40 dropJ n (Append _ l r) | n > (getSize (size (tag l))) =
  41                            dropJ (n - getSize (size (tag l))) r
  42                        | otherwise = let lft = dropJ n l in
  43                                      Append ((tag lft) `mappend` (tag r)) lft r