git.iko.soy/elk
on master help sign in
Move Bag and OneOrMore to Data/ directory
c19392fEvan Czaplicki
src/Canonicalize/Bag.hsdeleted−68
compare with master
unifiedsplit
@@ -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 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2−module Canonicalize.OneOrMore
2+module Data.OneOrMore
3 ( OneOrMore(..)
3 ( OneOrMore(..)
4 , one
4 , one
5 , more
5 , 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 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# 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
3
15
4import Control.Monad.Except (Except, runExcept)
16import Control.Monad.Except (Except, runExcept)
5
17
18+import qualified Data.Bag as Bag
6import qualified Reporting.Annotation as A
19import qualified Reporting.Annotation as A
7−import qualified Reporting.Bag as Bag
8import qualified Reporting.Region as R
20import qualified Reporting.Region as R
9
21
10
22
@@ -41,12 +53,7 @@ ok value =
41
53
42throw :: (Monoid i) => R.Region -> e -> Result i w e a
54throw :: (Monoid i) => R.Region -> e -> Result i w e a
43throw region err =
55throw region err =
44− Result mempty Bag.empty (Err (Bag.singleton (A.A region err)))
56+ Result mempty Bag.empty (Err (Bag.one (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))
50
57
51
58
52accumulate :: (Monoid i) => i -> a -> Result i w e a
59accumulate :: (Monoid i) => i -> a -> Result i w e a
@@ -56,7 +63,7 @@ accumulate info value =
56
63
57warn :: (Monoid i) => R.Region -> w -> a -> Result i w e a
64warn :: (Monoid i) => R.Region -> w -> a -> Result i w e a
58warn region warning a =
65warn 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)
60
67
61
68
62
69
@@ -70,7 +77,7 @@ from f except =
70 ok answer
77 ok answer
71
78
72 Left errors ->
79 Left errors ->
73− throwMany (map (A.map f) errors)
80+ Result mempty Bag.empty (Err (Bag.fromList (A.map f) errors))
74
81
75
82
76mapError :: (e -> e') -> Result i w e a -> Result i w e' a
83mapError :: (e -> e') -> Result i w e a -> Result i w e' a
@@ -96,7 +103,7 @@ answerToEither onErr onOk answer =
96 Right (onOk value)
103 Right (onOk value)
97
104
98 Err errors ->
105 Err errors ->
99− Left (Bag.toList onErr errors)
106+ Left (map onErr (Bag.toList errors))
100
107
101
108
102oneToValue :: b -> (a -> b) -> One a -> b
109oneToValue :: b -> (a -> b) -> One a -> b