A start
This commit is contained in:
parent
908d24a712
commit
d99f7b814a
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user