]> git.rkrishnan.org Git - yorgey.git/blob - hw7/JoinList.hs
exercise 3
[yorgey.git] / hw7 / JoinList.hs
1 {-# OPTIONS_GHC -Wall #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE TypeSynonymInstances #-}
4
5 module JoinList where
6
7 import Data.Monoid
8 import Sized
9 import Scrabble
10 import Buffer
11 import Editor
12
13 data JoinList m a = Empty
14                   | Single m a
15                   | Append m (JoinList m a) (JoinList m a)
16                     deriving (Eq, Show)
17
18 jlToList :: JoinList m a -> [a]
19 jlToList Empty = []
20 jlToList (Single m a) = [a]
21 jlToList (Append m lt rt) = jlToList lt ++ jlToList rt
22
23 -- exercise 1
24 tag :: Monoid m => JoinList m a -> m
25 tag (Empty) = mempty
26 tag (Single t _) = t
27 tag (Append t _ _) = t
28
29 (+++) :: Monoid m => JoinList m a -> JoinList m a -> JoinList m a
30 Empty +++ x = x
31 x +++ Empty = x
32 alst1 +++ alst2 = Append ((tag alst1) `mappend` (tag alst2)) alst1 alst2
33
34 -- exercise 2
35 -- 1. index
36 indexJ :: (Sized b, Monoid b) =>
37           Int -> JoinList b a -> Maybe a
38 indexJ _ Empty = Nothing
39 indexJ n _ | n < 0 = Nothing
40 indexJ n (Single _ a) | n == 0 = Just a
41                       | otherwise = Nothing
42 indexJ n (Append t l r) | n >= getSize (size t) = Nothing
43                         | n < 0 = Nothing
44                         | n < (getSize (size (tag l))) = indexJ n l
45                         | otherwise = indexJ (n - getSize (size (tag l))) r
46
47 -- 2. drop
48 dropJ :: (Sized b, Monoid b) =>
49          Int -> JoinList b a -> JoinList b a
50 dropJ n x | n < 0 = x
51 dropJ 0 x = x
52 dropJ _ Empty = Empty
53 dropJ n v@(Single _ _) | n == 0 = v
54                        | otherwise = Empty
55 dropJ n (Append t l r) | n > getSize (size t) = Empty
56                        | n > leftSize =
57                            dropJ (n - leftSize) r
58                        | otherwise = let lft = dropJ n l in
59                                      Append ((tag lft) `mappend` (tag r)) lft r
60                        where leftSize = getSize . size . tag $ l
61
62 -- 3. take
63 takeJ :: (Sized b, Monoid b) =>
64          Int -> JoinList b a -> JoinList b a
65 takeJ 0 _ = Empty
66 takeJ n _ | n < 0 = Empty
67 takeJ _ Empty = Empty
68 takeJ n v@(Single _ _) | n == 0 = v
69                        | otherwise = Empty
70 takeJ n v@(Append t l r) | n > getSize (size t) = v
71                          | n < leftSize = takeJ n l
72                          | otherwise = let rt = takeJ (n - leftSize) r in
73                                        Append ((tag l) `mappend` (tag rt)) l rt
74                          where leftSize = getSize . size . tag $ l
75
76
77 -- exercise 3 (Scrabble.hs)
78 scoreLine :: String -> JoinList Score String
79 scoreLine l = let scores = map scoreString . words $ l
80                   scoresAndWords = zip scores (words l)
81               in
82                 foldr (+++) Empty $ map (\(s, w) -> Single s w) scoresAndWords
83
84 -- exercise 4
85 -- instance (Monoid a, Monoid b) => Monoid (a,b) where
86 --   mempty = (mempty, mempty)
87 --   (a,b) `mappend` (c,d) = ((a `mappend` c), (b `mappend` d))
88
89
90 instance Buffer (JoinList (Score, Size) String) where
91   toString = unlines . jlToList
92
93   fromString = foldr (+++) Empty . map (\x -> Single (scoreString x, Size 1) x) . lines 
94   line n b = indexJ n b
95   replaceLine n l b = let pre = takeJ (n - 1) b
96                           post = dropJ n b
97                           (Append m1 _ _) = scoreLine l
98                       in
99                        pre +++ (Single (m1, Size (length l)) l) +++ post
100   numLines = \x -> case x of
101                      Empty -> 0
102                      Single _ _ -> 1
103                      Append _ l r -> numLines l + numLines r
104
105   value = \x -> case x of
106                   Empty -> 0
107                   Single (_, m2) _ -> getSize . size $ m2
108                   Append (_, m2) _ _ -> getSize . size $ m2
109
110 main = runEditor editor $ Single (Score 244,Size 177) "This buffer is for notes you don't want to save, and for evaluation of steam valve coefficients. To load a different file, type the character L followed by the name of the file."
111 --         [ "This buffer is for notes you don't want to save, and for"
112 --         , "evaluation of steam valve coefficients."
113 --         , "To load a different file, type the character L followed"
114 --         , "by the name of the file."
115 --         ]
116 -- "This buffer is for notes you don't want to save, and for evaluation of steam valve -- coefficients. To load a different file, type the character L followed by the name of the file."