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