formatting is my passion
This commit is contained in:
parent
d99f7b814a
commit
dd3c3b1d9e
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user