formatting is my passion

This commit is contained in:
pingu 2024-02-29 18:23:17 +01:00
parent d99f7b814a
commit 0d3fb79f54
2 changed files with 19 additions and 15 deletions

View File

@ -9,14 +9,14 @@ module GoodList (
data GoodList a = Empty | Singleton a | Multiple a (GoodList a) a data GoodList a = Empty | Singleton a | Multiple a (GoodList a) a
instance Functor GoodList where instance Functor GoodList where
fmap _ Empty = Empty fmap _ Empty = Empty
fmap f (Singleton a) = singleton $ f a fmap f (Singleton a) = singleton $ f a
fmap f (Multiple a b c) = Multiple (f a) (fmap f b) (f c) fmap f (Multiple a b c) = Multiple (f a) (fmap f b) (f c)
instance Applicative GoodList where instance Applicative GoodList where
pure = singleton pure = singleton
Empty <*> _ = Empty Empty <*> _ = Empty
(Singleton f) <*> x = fmap f x (Singleton f) <*> x = fmap f x
(Multiple a b c) <*> x = append (append (fmap a x) (b <*> x)) (fmap c x) (Multiple a b c) <*> x = append (append (fmap a x) (b <*> x)) (fmap c x)
instance Semigroup (GoodList a) where instance Semigroup (GoodList a) where
@ -29,28 +29,28 @@ instance Show a => Show (GoodList a) where
show x = "[" ++ show' x ++ "]" show x = "[" ++ show' x ++ "]"
where where
show' :: Show a => GoodList a -> String show' :: Show a => GoodList a -> String
show' Empty = "" show' Empty = ""
show' (Singleton a) = show a show' (Singleton a) = show a
show' (Multiple a Empty c) = show a ++ ", " ++ show c 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 :: a -> GoodList a
singleton = Singleton singleton = Singleton
cons :: a -> GoodList a -> GoodList a cons :: a -> GoodList a -> GoodList a
cons x Empty = singleton x cons x Empty = singleton x
cons x (Singleton a) = Multiple x Empty a cons x (Singleton a) = Multiple x Empty a
cons x (Multiple a b c) = Multiple x (a `cons` b) c cons x (Multiple a b c) = Multiple x (a `cons` b) c
snoc :: GoodList a -> a -> GoodList a snoc :: GoodList a -> a -> GoodList a
snoc Empty = singleton snoc Empty = singleton
snoc (Singleton a) = Multiple a Empty snoc (Singleton a) = Multiple a Empty
snoc (Multiple a b c) = Multiple a (b `snoc` c) snoc (Multiple a b c) = Multiple a (b `snoc` c)
append :: GoodList a -> GoodList a -> GoodList a append :: GoodList a -> GoodList a -> GoodList a
append Empty ys = ys append Empty ys = ys
append (Singleton x) ys = cons x ys append (Singleton x) ys = cons x ys
append xs Empty = xs append xs Empty = xs
append (Multiple a b c) (Singleton y) = Multiple a (snoc b c) y 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 append (Multiple a b c) (Multiple d e f) = Multiple a (snoc b c `append` cons d e) f

View File

@ -1,4 +1,8 @@
module Main (main) where module Main (main) where
import GoodList
abc :: GoodList Char
abc = cons 'a' $ cons 'b' $ cons 'c' Empty
main :: IO () main :: IO ()
main = putStrLn "Test suite not yet implemented." main = print abc