git.iko.soy/elk
on master help sign in
Move Bag and OneOrMore to Data/ directory
commitc19392fbe3489cffc2ea2b760af9d579ae412bb8 authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 27 Oct 2017, 18:13 (9 years ago) parent38bfa1b
5 files changed+140−181
compare with master
unifiedsplit
src/Canonicalize/Bag.hs−68 src/Data/Bag.hs+121 src/Canonicalize/OneOrMore.hs → src/Data/OneOrMore.hs+1−1 src/Reporting/Bag.hs−101 src/Reporting/Result.hs+18−11
src/Canonicalize/Bag.hsdeleted−68
@@ -1,68 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−module Canonicalize.Bag
3− ( Bag(..)
4− , empty
5− , one
6− , append
7− , toList
8− )
9− where
10−
11−
12−
13−-- BAGS
14−
15−
16−data Bag a
17− = Empty
18− | One a
19− | Two (Bag a) (Bag a)
20−
21−
22−
23−-- HELPERS
24−
25−
26−empty :: Bag a
27−empty =
28− Empty
29−
30−
31−one :: a -> Bag a
32−one =
33− One
34−
35−
36−append :: Bag a -> Bag a -> Bag a
37−append left right =
38− case (left, right) of
39− (other, Empty) ->
40− other
41−
42− (Empty, other) ->
43− other
44−
45− (_, _) ->
46− Two left right
47−
48−
49−
50−-- TO LIST
51−
52−
53−toList :: Bag a -> [a]
54−toList bag =
55− toListHelp bag []
56−
57−
58−toListHelp :: Bag a -> [a] -> [a]
59−toListHelp bag list =
60− case bag of
61− Empty ->
62− list
63−
64− One x ->
65− x : list
66−
67− Two a b ->
68− toListHelp a (toListHelp b list)
src/Data/Bag.hsnew file+121
@@ -0,0 +1,121 @@
1+{-# OPTIONS_GHC -Wall #-}
2+module Data.Bag
3+ ( Bag(..)
4+ , empty
5+ , one
6+ , append
7+ , map
8+ , toList
9+ , fromList
10+ )
11+ where
12+
13+
14+import Prelude hiding (map)
15+import qualified Data.List as List
16+
17+
18+
19+-- BAGS
20+
21+
22+data Bag a
23+ = Empty
24+ | One a
25+ | Two (Bag a) (Bag a)
26+
27+
28+
29+-- HELPERS
30+
31+
32+empty :: Bag a
33+empty =
34+ Empty
35+
36+
37+one :: a -> Bag a
38+one =
39+ One
40+
41+
42+append :: Bag a -> Bag a -> Bag a
43+append left right =
44+ case (left, right) of
45+ (other, Empty) ->
46+ other
47+
48+ (Empty, other) ->
49+ other
50+
51+ (_, _) ->
52+ Two left right
53+
54+
55+
56+-- MAP
57+
58+
59+map :: (a -> b) -> Bag a -> Bag b
60+map func bag =
61+ case bag of
62+ Empty ->
63+ Empty
64+
65+ One a ->
66+ One (func a)
67+
68+ Two left right ->
69+ Two (map func left) (map func left)
70+
71+
72+
73+-- TO LIST
74+
75+
76+toList :: Bag a -> [a]
77+toList bag =
78+ toListHelp bag []
79+
80+
81+toListHelp :: Bag a -> [a] -> [a]
82+toListHelp bag list =
83+ case bag of
84+ Empty ->
85+ list
86+
87+ One x ->
88+ x : list
89+
90+ Two a b ->
91+ toListHelp a (toListHelp b list)
92+
93+
94+
95+-- FROM LIST
96+
97+
98+fromList :: (a -> b) -> [a] -> Bag b
99+fromList func list =
100+ case list of
101+ [] ->
102+ Empty
103+
104+ first : rest ->
105+ List.foldl' (add func) (One (func first)) rest
106+
107+
108+add :: (a -> b) -> Bag b -> a -> Bag b
109+add func bag value =
110+ Two (One (func value)) bag
111+
112+
113+
114+-- MONOID
115+
116+
117+instance Monoid (Bag a) where
118+ {-# INLINE mempty #-}
119+ mempty = Empty
120+ {-# INLINE mappend #-}
121+ mappend = Two
src/Canonicalize/OneOrMore.hs → src/Data/OneOrMore.hsrenamed+1−1
@@ -1,5 +1,5 @@
11{-# OPTIONS_GHC -Wall #-}
2−module Canonicalize.OneOrMore
2+module Data.OneOrMore
33 ( OneOrMore(..)
44 , one
55 , more
src/Reporting/Bag.hsdeleted−101
@@ -1,101 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−module Reporting.Bag
3− ( Bag
4− , empty, singleton, cons, append, map
5− , toList, fromList
6− )
7− where
8−
9−
10−import Prelude hiding (map)
11−
12−
13−
14−-- BAGS
15−
16−
17−data Bag a
18− = Empty
19− | One a
20− | Two (Bag a) (Bag a)
21− | Many [a]
22−
23−
24−empty :: Bag a
25−empty =
26− Empty
27−
28−
29−singleton :: a -> Bag a
30−singleton =
31− One
32−
33−
34−cons :: a -> Bag a -> Bag a
35−cons x bag =
36− case bag of
37− Empty ->
38− One x
39−
40− _ ->
41− Two (One x) bag
42−
43−
44−append :: Bag a -> Bag a -> Bag a
45−append left right =
46− case (left, right) of
47− (other, Empty) ->
48− other
49−
50− (Empty, other) ->
51− other
52−
53− (_, _) ->
54− Two left right
55−
56−
57−map :: (a -> b) -> Bag a -> Bag b
58−map func bag =
59− case bag of
60− Empty ->
61− Empty
62−
63− One x ->
64− One (func x)
65−
66− Two left right ->
67− Two (map func left) (map func right)
68−
69− Many xs ->
70− Many (fmap func xs)
71−
72−
73−
74−-- LIST CONVERSIONS
75−
76−
77−fromList :: [a] -> Bag a
78−fromList =
79− Many
80−
81−
82−toList :: (a -> b) -> Bag a -> [b]
83−toList func bag =
84− toListHelp func bag []
85−
86−
87−toListHelp :: (a -> b) -> Bag a -> [b] -> [b]
88−toListHelp func bag list =
89− case bag of
90− Empty ->
91− list
92−
93− One x ->
94− func x : list
95−
96− Two left right ->
97− toListHelp func left (toListHelp func right list)
98−
99− Many xs ->
100− foldr (\x newList -> func x : newList) list xs
101−
src/Reporting/Result.hs+18−11
@@ -1,10 +1,22 @@
11{-# OPTIONS_GHC -Wall #-}
2−module Reporting.Result where
2+module Reporting.Result
3+ ( Result(..)
4+ , ok
5+ , throw
6+ , accumulate
7+ , warn
8+ , from
9+ , mapError
10+ , format
11+ , answerToEither
12+ , oneToValue
13+ )
14+ where
315
416import Control.Monad.Except (Except, runExcept)
517
18+import qualified Data.Bag as Bag
619import qualified Reporting.Annotation as A
7−import qualified Reporting.Bag as Bag
820import qualified Reporting.Region as R
921
1022
@@ -41,12 +53,7 @@ ok value =
4153
4254throw :: (Monoid i) => R.Region -> e -> Result i w e a
4355throw region err =
44− Result mempty Bag.empty (Err (Bag.singleton (A.A region err)))
45−
46−
47−throwMany :: (Monoid i) => [A.Located e] -> Result i w e a
48−throwMany errors =
49− Result mempty Bag.empty (Err (Bag.fromList errors))
56+ Result mempty Bag.empty (Err (Bag.one (A.A region err)))
5057
5158
5259accumulate :: (Monoid i) => i -> a -> Result i w e a
@@ -56,7 +63,7 @@ accumulate info value =
5663
5764warn :: (Monoid i) => R.Region -> w -> a -> Result i w e a
5865warn region warning a =
59− Result mempty (Bag.singleton (A.A region warning)) (Ok a)
66+ Result mempty (Bag.one (A.A region warning)) (Ok a)
6067
6168
6269
@@ -70,7 +77,7 @@ from f except =
7077 ok answer
7178
7279 Left errors ->
73− throwMany (map (A.map f) errors)
80+ Result mempty Bag.empty (Err (Bag.fromList (A.map f) errors))
7481
7582
7683mapError :: (e -> e') -> Result i w e a -> Result i w e' a
@@ -96,7 +103,7 @@ answerToEither onErr onOk answer =
96103 Right (onOk value)
97104
98105 Err errors ->
99− Left (Bag.toList onErr errors)
106+ Left (map onErr (Bag.toList errors))
100107
101108
102109oneToValue :: b -> (a -> b) -> One a -> b