diff --git a/src/GoodList.hs b/src/GoodList.hs index 6d7b79d..0db6ab1 100644 --- a/src/GoodList.hs +++ b/src/GoodList.hs @@ -9,14 +9,14 @@ module GoodList ( data GoodList a = Empty | Singleton a | Multiple a (GoodList a) a instance Functor GoodList where - fmap _ Empty = Empty - fmap f (Singleton a) = singleton $ f a + fmap _ Empty = Empty + fmap f (Singleton a) = singleton $ f a fmap f (Multiple a b c) = Multiple (f a) (fmap f b) (f c) instance Applicative GoodList where pure = singleton - Empty <*> _ = Empty - (Singleton f) <*> x = fmap f x + Empty <*> _ = Empty + (Singleton f) <*> x = fmap f x (Multiple a b c) <*> x = append (append (fmap a x) (b <*> x)) (fmap c x) instance Semigroup (GoodList a) where @@ -29,28 +29,28 @@ instance Show a => Show (GoodList a) where show x = "[" ++ show' x ++ "]" where show' :: Show a => GoodList a -> String - show' Empty = "" - show' (Singleton a) = show a + show' Empty = "" + show' (Singleton a) = show a show' (Multiple a Empty c) = show a ++ ", " ++ show c - show' (Multiple a b c) = show a ++ ", " ++ show' b ++ ", " ++ show c + show' (Multiple a b c) = show a ++ ", " ++ show' b ++ ", " ++ show c singleton :: a -> GoodList a singleton = Singleton cons :: a -> GoodList a -> GoodList a -cons x Empty = singleton x -cons x (Singleton a) = Multiple x Empty a +cons x Empty = singleton x +cons x (Singleton a) = Multiple x Empty a cons x (Multiple a b c) = Multiple x (a `cons` b) c snoc :: GoodList a -> a -> GoodList a -snoc Empty = singleton -snoc (Singleton a) = Multiple a Empty +snoc Empty = singleton +snoc (Singleton a) = Multiple a Empty snoc (Multiple a b c) = Multiple a (b `snoc` c) append :: GoodList a -> GoodList a -> GoodList a -append Empty ys = ys -append (Singleton x) ys = cons x ys -append xs Empty = xs +append Empty ys = ys +append (Singleton x) ys = cons x ys +append xs Empty = xs append (Multiple a b c) (Singleton y) = Multiple a (snoc b c) y append (Multiple a b c) (Multiple d e f) = Multiple a (snoc b c `append` cons d e) f diff --git a/test/Main.hs b/test/Main.hs index 3e2059e..ed63923 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,4 +1,8 @@ module Main (main) where +import GoodList + +abc :: GoodList Char +abc = cons 'a' $ cons 'b' $ cons 'c' Empty main :: IO () -main = putStrLn "Test suite not yet implemented." +main = print abc