on f4401ac help sign in
110 lines 1.3 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Data.Bag
3 ( Bag(..)
4 , empty
5 , one
6 , append
7 , map
8 , toList
9 , fromList
10 )
11 where
14import Prelude hiding (map)
15import qualified Data.List as List
19-- BAGS
22data Bag a
23 = Empty
24 | One a
25 | Two (Bag a) (Bag a)
29-- HELPERS
32empty :: Bag a
33empty =
34 Empty
37one :: a -> Bag a
38one =
39 One
42append :: Bag a -> Bag a -> Bag a
43append left right =
44 case (left, right) of
45 (other, Empty) ->
46 other
48 (Empty, other) ->
49 other
51 (_, _) ->
52 Two left right
56-- MAP
59map :: (a -> b) -> Bag a -> Bag b
60map func bag =
61 case bag of
62 Empty ->
63 Empty
65 One a ->
66 One (func a)
68 Two left right ->
69 Two (map func left) (map func right)
73-- TO LIST
76toList :: Bag a -> [a]
77toList bag =
78 toListHelp bag []
81toListHelp :: Bag a -> [a] -> [a]
82toListHelp bag list =
83 case bag of
84 Empty ->
85 list
87 One x ->
88 x : list
90 Two a b ->
91 toListHelp a (toListHelp b list)
95-- FROM LIST
98fromList :: (a -> b) -> [a] -> Bag b
99fromList func list =
100 case list of
101 [] ->
102 Empty
104 first : rest ->
105 List.foldl' (add func) (One (func first)) rest
108add :: (a -> b) -> Bag b -> a -> Bag b
109add func bag value =
110 Two (One (func value)) bag