This commit is contained in:
pingu 2024-02-29 18:08:13 +01:00
parent 908d24a712
commit d99f7b814a

View File

@ -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