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 n (Single _ a) | n == 0 = Just a
  30                       | otherwise = Nothing
  31 indexJ n (Append t l r) | n >= getSize (size t) = Nothing
  32                         | n < 0 = Nothing
  33                         | n < (getSize (size (tag l))) = indexJ n l
  34                         | otherwise = indexJ (n - getSize (size (tag l))) r
  35
  36 -- 2. drop
  37 dropJ :: (Sized b, Monoid b) =>
  38          Int -> JoinList b a -> JoinList b a
  39 dropJ n x | n < 0 = x
  40 dropJ 0 x = x
  41 dropJ _ Empty = Empty
  42 dropJ n v@(Single _ _) | n == 0 = v
  43                        | otherwise = Empty
  44 dropJ n (Append t l r) | n > getSize (size t) = Empty
  45                        | n > leftSize =
  46                            dropJ (n - leftSize) r
  47                        | otherwise = let lft = dropJ n l in
  48                                      Append ((tag lft) `mappend` (tag r)) lft r
  49                        where leftSize = getSize . size . tag $ l
  50
  51 -- 3. take
  52 takeJ :: (Sized b, Monoid b) =>
  53          Int -> JoinList b a -> JoinList b a
  54 takeJ 0 _ = Empty
  55 takeJ n _ | n < 0 = Empty
  56 takeJ _ Empty = Empty
  57 takeJ n v@(Single _ _) | n == 0 = v
  58                        | otherwise = Empty
  59 takeJ n v@(Append t l r) | n > getSize (size t) = v
  60                          | n < leftSize = takeJ n l
  61                          | otherwise = let rt = takeJ (n - leftSize) r in
  62                                        Append ((tag l) `mappend` (tag rt)) l rt
  63                          where leftSize = getSize . size . tag $ l
  64