From d99f7b814a11e9940914cb2d7b7d81f344088a55 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 | 58 ++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 55 insertions(+), 3 deletions(-)

diff --git a/src/GoodList.hs b/src/GoodList.hs
index 24bf959..6d7b79d 100644
--- a/src/GoodList.hs
+++ b/src/GoodList.hs
@@ -1,4 +1,56 @@
-module GoodList (someFunc) where
+module GoodList (
+                  GoodList(..)
+                , singleton
+                , cons
+                , snoc
+                , append
+                ) 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 ++ "]"
+    where
+      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