summaryrefslogtreecommitdiff
path: root/lec07/JoinList.hs
blob: 5e1949fcd19595fce40b4d7e977b9aef0e317796 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
module JoinList where

import Sized
import Scrabble

data JoinList m a = Empty
                  | Single m a
                  | Append m (JoinList m a) (JoinList m a)
  deriving (Eq, Show)

-- Exercise 1

tag :: Monoid m => JoinList m a -> m
tag Empty = mempty
tag (Single m _) = m
tag (Append m _ _) = m

(+++) :: Monoid m => JoinList m a -> JoinList m a -> JoinList m a
(+++) jl1 jl2 = Append (mappend (tag jl1) (tag jl2)) jl1 jl2

-- Exercise 2

indexJ :: (Sized b, Monoid b) => Int -> JoinList b a -> Maybe a
indexJ _ Empty = Nothing
indexJ n (Single _ a)
       | n == 0 = Just a
       | otherwise = Nothing
indexJ n (Append m jl1 jl2)
       | n < 0 || n >= (getSize $ size m) = Nothing
       | n < s1 = indexJ n jl1
       | n >= s1 = indexJ (n - s1) jl2
       where s1 = getSize $ size $ tag jl1

dropJ :: (Sized b, Monoid b) => Int -> JoinList b a -> JoinList b a
dropJ _ Empty = Empty
dropJ n jl@(Single _ _)
      | n >= 1 = Empty
      | otherwise = jl
dropJ n jl@(Append m jl1 jl2)
      | n <= 0 = jl
      | n >= m' = Empty
      | n < s1 = dropJ n jl1 +++ jl2
      | n >= s1 = dropJ (n - s1) jl2
      where
        s1 = getSize $ size $ tag jl1
        m' = getSize $ size m

takeJ :: (Sized b, Monoid b) => Int -> JoinList b a -> JoinList b a
takeJ _ Empty = Empty
takeJ n _ | n <= 0 = Empty
takeJ n jl@(Single _ _) = jl
takeJ n jl@(Append m jl1 jl2)
      | n >= m' = jl
      | n < s1 = takeJ n jl1
      | n >= s1 = jl1 +++ takeJ (n - s1) jl2
      where
        s1 = getSize $ size $ tag jl1
        m' = getSize $ size m