pingu/GoodList
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Monad, probs

Browse Source
This commit is contained in:
pingu 2024-02-29 19:02:20 +01:00
parent 011050fe3a
commit 604206776f
1 changed files with 6 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/GoodList.hs
View File

@ -22,9 +22,7 @@ instance Applicative GoodList where
-- Needs to be proven -- Needs to be proven
instance Monad GoodList where instance Monad GoodList where
return = pure return = pure
Empty >>= _ = Empty x >>= f = join $ fmap f x
Singleton x >>= f = f x
Multiple a b c >>= f = append (append (f a) (b >>= f)) (f c)
instance Semigroup (GoodList a) where instance Semigroup (GoodList a) where
(<>) = append (<>) = append
@ -60,3 +58,8 @@ 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
join :: GoodList (GoodList a) -> GoodList a
join Empty = Empty
join (Singleton x) = x
join (Multiple a b c) = append (a `append` join b) c