git.iko.soy/elk
on master help sign in
Move Elm.Constraint and Elm.Licenses
a66a03fEvan Czaplicki
builder/src/Elm/Project/Constraint.hs → builder/src/Elm/Constraint.hsrenamed+90−68
compare with master
unifiedsplit
@@ -1,12 +1,13 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3−module Elm.Project.Constraint
3+module Elm.Constraint
4 ( Constraint
4 ( Constraint
5 , exactly
5 , exactly
6 , anything
6 , anything
7− , fromText
7+ , toChars
8 , toString
8 , toString
9− , toText
9+ , Error(..)
10+ , fromString
10 , satisfies
11 , satisfies
11 , check
12 , check
12 , intersect
13 , intersect
@@ -15,18 +16,19 @@ module Elm.Project.Constraint
15 , untilNextMajor
16 , untilNextMajor
16 , untilNextMinor
17 , untilNextMinor
17 , expand
18 , expand
19+ , decoder
20+ , encode
18 )
21 )
19 where
22 where
20
23
21
24
22import Control.Monad (liftM4)
25import Control.Monad (liftM4)
23−import Data.Binary
26+import Data.Binary (Binary, get, put, getWord8, putWord8)
24−import qualified Data.Text as Text
27+import qualified Data.Utf8 as Utf8
25−import Data.Text (Text)
26
28
27−import qualified Elm.Compiler as Compiler
29+import qualified Elm.Version as V
28−import qualified Elm.Package as Pkg
30+import qualified Json.Decode as D
29−import Elm.Package (Version(..))
31+import qualified Json.Encode as E
30
32
31
33
32
34
@@ -34,7 +36,7 @@ import Elm.Package (Version(..))
34
36
35
37
36data Constraint
38data Constraint
37− = Range Version Op Op Version
39+ = Range V.Version Op Op V.Version
38 deriving (Eq)
40 deriving (Eq)
39
41
40
42
@@ -48,96 +50,96 @@ data Op
48-- COMMON CONSTRAINTS
50-- COMMON CONSTRAINTS
49
51
50
52
51−exactly :: Version -> Constraint
53+exactly :: V.Version -> Constraint
52exactly version =
54exactly version =
53 Range version LessOrEqual LessOrEqual version
55 Range version LessOrEqual LessOrEqual version
54
56
55
57
56anything :: Constraint
58anything :: Constraint
57anything =
59anything =
58− Range (Version 1 0 0) LessOrEqual LessOrEqual (Version maxBound 0 0)
60+ Range V.one LessOrEqual LessOrEqual V.max
59
61
60
62
61
63
62−-- TEXT CONVERSION
64+-- TO STRING
63
65
64
66
65−toString :: Constraint -> String
67+toChars :: Constraint -> String
66−toString constraint =
68+toChars constraint =
67− Text.unpack (toText constraint)
69+ Utf8.toChars (toString constraint)
68
70
69
71
70−toText :: Constraint -> Text
72+toString :: Constraint -> Utf8.String
71−toText constraint =
73+toString constraint =
72 case constraint of
74 case constraint of
73 Range lower lowerOp upperOp upper ->
75 Range lower lowerOp upperOp upper ->
74− Text.intercalate " "
76+ Utf8.join 0x20 {- -}
75− [ Pkg.versionToText lower
77+ [ V.toString lower
76− , opToText lowerOp
78+ , toStringHelp lowerOp
77 , "v"
79 , "v"
78− , opToText upperOp
80+ , toStringHelp upperOp
79− , Pkg.versionToText upper
81+ , V.toString upper
80 ]
82 ]
81
83
82
84
83−opToText :: Op -> Text
85+toStringHelp :: Op -> Utf8.String
84−opToText op =
86+toStringHelp op =
85 case op of
87 case op of
86− Less ->
88+ Less -> "<"
87− "<"
89+ LessOrEqual -> "<="
90+
88
91
89− LessOrEqual ->
90− "<="
91
92
93+-- FROM STRING
92
94
95+
96+data Error
97+ = BadLower Utf8.String
98+ | BadUpper Utf8.String
99+ | BadFormat
100+ | InvalidOp
101+ | InvalidRange V.Version V.Version
102+
103+
93−fromText :: Text -> Either String Constraint
104+fromString :: Utf8.String -> Either Error Constraint
94−fromText text =
105+fromString string =
95− case Text.splitOn " " text of
106+ case Utf8.split 0x20 {- -} string of
96 [lower, lowerOp, "v", upperOp, upper] ->
107 [lower, lowerOp, "v", upperOp, upper] ->
97− do lo <- versionFromText "lower" lower
108+ do lo <- versionFromString lower BadLower
98− lop <- opFromText lowerOp
109+ lop <- opFromString lowerOp
99− hop <- opFromText upperOp
110+ hop <- opFromString upperOp
100− hi <- versionFromText "upper" upper
111+ hi <- versionFromString upper BadUpper
101 if lo < hi
112 if lo < hi
102 then Right (Range lo lop hop hi)
113 then Right (Range lo lop hop hi)
103− else
114+ else Left (InvalidRange lo hi)
104− Left $
105− "The lower bound (" ++ Text.unpack lower
106− ++ ") must be less than the upper bound ("
107− ++ Text.unpack upper ++ ")"
108
115
109 _ ->
116 _ ->
110− Left "The standard format is \"1.0.0 <= v < 2.0.0\""
117+ Left BadFormat
111
118
112
119
113−versionFromText :: String -> Text -> Either String Version
120+versionFromString :: Utf8.String -> (Utf8.String -> Error) -> Either Error V.Version
114−versionFromText lowerOrUpper text =
121+versionFromString string toError =
115− case Pkg.versionFromText text of
122+ case V.fromString string of
116 Just vsn ->
123 Just vsn ->
117 Right vsn
124 Right vsn
118
125
119 Nothing ->
126 Nothing ->
120− Left $ "The " ++ lowerOrUpper ++ " bound (" ++ Text.unpack text ++ ") is not a valid version number."
127+ Left (toError string)
121
128
122
129
123−opFromText :: Text -> Either String Op
130+opFromString :: Utf8.String -> Either Error Op
124−opFromText text =
131+opFromString text =
125 case text of
132 case text of
126− "<=" ->
127− Right LessOrEqual
133+ "<=" -> Right LessOrEqual
128−
129− "<" ->
130− Right Less
134+ "<" -> Right Less
131−
135+ _ -> Left InvalidOp
132− _ ->
133− Left $ "The operator (" ++ Text.unpack text ++ ") is not valid. Must be (<=) or (<)."
134
136
135
137
136
138
137-- IS SATISFIED
139-- IS SATISFIED
138
140
139
141
140−satisfies :: Constraint -> Version -> Bool
142+satisfies :: Constraint -> V.Version -> Bool
141satisfies constraint version =
143satisfies constraint version =
142 case constraint of
144 case constraint of
143 Range lower lowerOp upperOp upper ->
145 Range lower lowerOp upperOp upper ->
@@ -156,7 +158,7 @@ isLess op =
156 (<=)
158 (<=)
157
159
158
160
159−check :: Constraint -> Version -> Ordering
161+check :: Constraint -> V.Version -> Ordering
160check constraint version =
162check constraint version =
161 case constraint of
163 case constraint of
162 Range lower lowerOp upperOp upper ->
164 Range lower lowerOp upperOp upper ->
@@ -201,43 +203,63 @@ intersect (Range lo lop hop hi) (Range lo_ lop_ hop_ hi_) =
201
203
202goodElm :: Constraint -> Bool
204goodElm :: Constraint -> Bool
203goodElm constraint =
205goodElm constraint =
204− satisfies constraint Compiler.version
206+ satisfies constraint V.compiler
205
207
206
208
207defaultElm :: Constraint
209defaultElm :: Constraint
208defaultElm =
210defaultElm =
209− if Pkg._major Compiler.version > 0
211+ if V._major V.compiler > 0
210− then untilNextMajor Compiler.version
212+ then untilNextMajor V.compiler
211− else untilNextMinor Compiler.version
213+ else untilNextMinor V.compiler
212
214
213
215
214
216
215-- CREATE CONSTRAINTS
217-- CREATE CONSTRAINTS
216
218
217
219
218−untilNextMajor :: Version -> Constraint
220+untilNextMajor :: V.Version -> Constraint
219untilNextMajor version =
221untilNextMajor version =
220− Range version LessOrEqual Less (Pkg.bumpMajor version)
222+ Range version LessOrEqual Less (V.bumpMajor version)
221
223
222
224
223−untilNextMinor :: Version -> Constraint
225+untilNextMinor :: V.Version -> Constraint
224untilNextMinor version =
226untilNextMinor version =
225− Range version LessOrEqual Less (Pkg.bumpMinor version)
227+ Range version LessOrEqual Less (V.bumpMinor version)
226
228
227
229
228−expand :: Constraint -> Version -> Constraint
230+expand :: Constraint -> V.Version -> Constraint
229expand constraint@(Range lower lowerOp upperOp upper) version
231expand constraint@(Range lower lowerOp upperOp upper) version
230 | version < lower =
232 | version < lower =
231 Range version LessOrEqual upperOp upper
233 Range version LessOrEqual upperOp upper
232
234
233 | version > upper =
235 | version > upper =
234− Range lower lowerOp Less (Pkg.bumpMajor version)
236+ Range lower lowerOp Less (V.bumpMajor version)
235
237
236 | otherwise =
238 | otherwise =
237 constraint
239 constraint
238
240
239
241
240
242
243+-- JSON
244+
245+
246+encode :: Constraint -> E.Value
247+encode constraint =
248+ E.string (toString constraint)
249+
250+
251+decoder :: D.Decoder Error Constraint
252+decoder =
253+ do str <- D.string
254+ case fromString str of
255+ Right constraint ->
256+ return constraint
257+
258+ Left err ->
259+ D.failure err
260+
261+
262+
241-- BINARY
263-- BINARY
242
264
243
265
builder/src/Elm/Project/Licenses.hs → builder/src/Elm/Licenses.hsrenamed+36−13
@@ -1,19 +1,22 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3−module Elm.Project.Licenses
3+module Elm.Licenses
4 ( License
4 ( License
5− , check
6 , bsd3
5 , bsd3
7 , encode
6 , encode
7+ , decoder
8 )
8 )
9 where
9 where
10
10
11
11
12+import Control.Monad (liftM2)
13+import Data.Binary (Binary, get, put)
12import Data.Map ((!))
14import Data.Map ((!))
13import qualified Data.Map as Map
15import qualified Data.Map as Map
14−import qualified Data.Text as Text
16+import qualified Data.Utf8 as Utf8
15
17
16−import qualified Json.Encode as Encode
18+import qualified Json.Decode as D
19+import qualified Json.Encode as E
17import qualified Reporting.Suggest as Suggest
20import qualified Reporting.Suggest as Suggest
18
21
19
22
@@ -23,8 +26,8 @@ import qualified Reporting.Suggest as Suggest
23
26
24data License =
27data License =
25 License
28 License
26− { _name :: Text.Text
29+ { _name :: Utf8.String
27− , _code :: Text.Text
30+ , _code :: Utf8.String
28 }
31 }
29 deriving (Eq, Ord)
32 deriving (Eq, Ord)
30
33
@@ -34,16 +37,27 @@ bsd3 =
34 osiApprovedSpdxLicenses ! "BSD-3-Clause"
37 osiApprovedSpdxLicenses ! "BSD-3-Clause"
35
38
36
39
37−encode :: License -> Encode.Value
40+encode :: License -> E.Value
38encode (License _ code) =
41encode (License _ code) =
39− Encode.text code
42+ E.string code
43+
44+
45+decoder :: (Utf8.String -> [Utf8.String] -> e) -> D.Decoder e License
46+decoder toError =
47+ do str <- D.string
48+ case check str of
49+ Right license ->
50+ return license
51+
52+ Left suggestions ->
53+ D.failure (toError str suggestions)
40
54
41
55
42
56
43-- CHECK
57-- CHECK
44
58
45
59
46−check :: Text.Text -> Either [Text.Text] License
60+check :: Utf8.String -> Either [Utf8.String] License
47check rawName =
61check rawName =
48 case Map.lookup rawName osiApprovedSpdxLicenses of
62 case Map.lookup rawName osiApprovedSpdxLicenses of
49 Just license ->
63 Just license ->
@@ -52,20 +66,20 @@ check rawName =
52 Nothing ->
66 Nothing ->
53 let
67 let
54 toPairs (License name code) =
68 toPairs (License name code) =
55− [ (Text.unpack code, code), (Text.unpack name, code) ]
69+ [ (Utf8.toChars code, code), (Utf8.toChars name, code) ]
56
70
57 pairs =
71 pairs =
58 concatMap toPairs (Map.elems osiApprovedSpdxLicenses)
72 concatMap toPairs (Map.elems osiApprovedSpdxLicenses)
59 in
73 in
60 Left $ map snd $
74 Left $ map snd $
61− Suggest.sort (Text.unpack rawName) fst pairs
75+ Suggest.sort (Utf8.toChars rawName) fst pairs
62
76
63
77
64
78
65-- LIST OF LICENCES
79-- LIST OF LICENCES
66
80
67
81
68−(==>) :: Text.Text -> Text.Text -> (Text.Text, License)
82+(==>) :: Utf8.String -> Utf8.String -> (Utf8.String, License)
69(==>) code name =
83(==>) code name =
70 ( code, License name code )
84 ( code, License name code )
71
85
@@ -74,7 +88,7 @@ check rawName =
74-- OSI approved licenses in SPDX format.
88-- OSI approved licenses in SPDX format.
75-- <https://spdx.org/licenses/>
89-- <https://spdx.org/licenses/>
76--
90--
77−osiApprovedSpdxLicenses :: Map.Map Text.Text License
91+osiApprovedSpdxLicenses :: Map.Map Utf8.String License
78osiApprovedSpdxLicenses =
92osiApprovedSpdxLicenses =
79 Map.fromList
93 Map.fromList
80 [ "AFL-1.1" ==> "Academic Free License v1.1"
94 [ "AFL-1.1" ==> "Academic Free License v1.1"
@@ -177,3 +191,12 @@ osiApprovedSpdxLicenses =
177 , "Zlib" ==> "zlib License"
191 , "Zlib" ==> "zlib License"
178 , "ZPL-2.0" ==> "Zope Public License 2.0"
192 , "ZPL-2.0" ==> "Zope Public License 2.0"
179 ]
193 ]
194+
195+
196+
197+-- BINARY
198+
199+
200+instance Binary License where
201+ get = liftM2 License get get
202+ put (License a b) = put a >> put b