From 9e00de79cfa3ac89fbeb88b0f453e6fbe98d45a7 Mon Sep 17 00:00:00 2001
From: pingu <nor@acorneroftheweb.com>
Date: Thu, 29 Feb 2024 18:08:13 +0100
Subject: [PATCH] A start

---
 src/GoodList.hs | 55 ++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 52 insertions(+), 3 deletions(-)

diff --git a/src/GoodList.hs b/src/GoodList.hs
index 24bf959..e592e92 100644
--- a/src/GoodList.hs
+++ b/src/GoodList.hs
@@ -1,4 +1,53 @@
-module GoodList (someFunc) where
+module GoodList (
+                  singleton
+                , cons
+                , snoc
+                ) where
 
-someFunc :: IO ()
-someFunc = putStrLn "someFunc"
+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 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
+  (Multiple a b c) <*> x = append (append (fmap a x) (b <*> x)) (fmap c x)
+
+instance Semigroup (GoodList a) where
+  (<>) = append
+
+instance Monoid (GoodList a) where
+  mempty = Empty
+
+instance Show a => Show (GoodList a) where
+  show x = "[" ++ show' x ++ "]"
+
+show' :: Show a => GoodList a -> String
+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
+
+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 (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 (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 (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