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 s = let ls = lines s in
  94                   foldr (+++) Empty $ map (\x -> Single (scoreString x, Size 1) x) ls
  95   line n b = indexJ n b
  96   replaceLine n l b = let pre = takeJ (n - 1) b
  97                           post = dropJ n b
  98                           (Append m1 _ _) = scoreLine l
  99                       in
 100                        pre +++ (Single (m1, Size (length l)) l) +++ post
 101   numLines = \x -> case x of
 102                      Empty -> 0
 103                      Single _ _ -> 1
 104                      Append _ l r -> numLines l + numLines r
 105
 106   value = \x -> case x of
 107                   Empty -> 0
 108                   Single (_, m2) _ -> getSize . size $ m2
 109                   Append (_, m2) _ _ -> getSize . size $ m2
 110
 111 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."
 112 --         [ "This buffer is for notes you don't want to save, and for"
 113 --         , "evaluation of steam valve coefficients."
 114 --         , "To load a different file, type the character L followed"
 115 --         , "by the name of the file."
 116 --         ]
 117 -- "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."