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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
module JoinList where
import Buffer
import Editor
import Scrabble
import Sized
import Data.List
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 ((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
-- Exercise 4
-- fold for join-lists
foldJ :: b -> (a -> b) -> (b -> b -> b) -> JoinList m a -> b
foldJ i _ _ Empty = i
foldJ _ f _ (Single _ a) = f a
foldJ i f g (Append _ jl1 jl2) = g (foldJ i f g jl1) (foldJ i f g jl2)
-- From a list, make a join-list that satisfies the properties of indexJ, takeJ,
-- and dropJ, with an additional function that calculates each annotation.
-- This function builds a join-list that has the most balanced branches.
makeJ :: Monoid m => (a -> m) -> [a] -> JoinList m a
makeJ _ [] = Empty
makeJ f [a] = Single (f a) a
makeJ f ls = (makeJ f $ dt ls 0 h) +++ (makeJ f $ dt ls h (l-h))
where
l = length ls
h = l `div` 2
dt ls x y = take y $ drop x ls
instance Buffer (JoinList (Score, Size) String) where
toString jl = foldJ "" id (\x y -> x ++ y) jl
fromString s = makeJ (\x -> (scoreString x, Size 1)) $ lines s
line = indexJ
replaceLine n ln jl = (takeJ (n-2) jl) +++ (Single (scoreString ln, 1) ln) +++ (dropJ n jl)
numLines = foldJ 0 (\_ -> 1) (\x y -> x + y)
value jl = getScore $ foldJ 0 (\s -> scoreString s) (\x y -> x <> y) jl
where getScore (Score s) = s
initialLines :: String
initialLines =
"This is the first line.\n" ++
"Then this, which is the second line.\n" ++
"As you might've guessed, this is the third.\n"
initialContent :: JoinList (Score, Size) String
initialContent = fromString initialLines
main = runEditor editor $ initialContent
-- error: No instance for ‘Applicative (Editor b)’ arising from the 'deriving' clause of a data type declaration
|