git.iko.soy/elk
on 267f708 help sign in
elk/src/Elm/Package.hs
254 lines 5.7 kB history raw
1module Elm.Package where
3import Data.Aeson
4import Data.Binary
5import qualified Data.Char as Char
6import Data.Function (on)
7import qualified Data.List as List
8import qualified Data.Text as T
9import System.FilePath ((</>))
12-- PACKGE NAMES
14data Name = Name
15 { user :: String
16 , project :: String
17 }
18 deriving (Eq, Ord, Show)
21type Package = (Name, Version)
24dummyName :: Name
25dummyName =
26 Name "user" "project"
29core :: Name
30core =
31 Name "elm-lang" "core"
34virtualDom :: Name
35virtualDom =
36 Name "elm-lang" "virtual-dom"
39html :: Name
40html =
41 Name "elm-lang" "html"
44toString :: Name -> String
45toString name =
46 user name ++ "/" ++ project name
49toUrl :: Name -> String
50toUrl name =
51 user name ++ "/" ++ project name
54toFilePath :: Name -> FilePath
55toFilePath name =
56 user name </> project name
59fromString :: String -> Either String Name
60fromString string =
61 case break (=='/') string of
62 ( user, '/' : project ) ->
63 if null user then
64 Left "You did not provide a user name (user/project)"
66 else if null project then
67 Left "You did not provide a project name (user/project)"
69 else if all (/='/') project then
70 Name user <$> validateProjectName project
72 else
73 Left "Expecting only one slash, separating the user and project name (user/project)"
75 _ ->
76 Left "There should be a slash separating the user and project name (user/project)"
79whitelistedUppercaseName :: String -> Bool
80whitelistedUppercaseName name =
81 -- These packages were uploaded to package.elm-lang.org before version 0.16,
82 -- when uppercase letters were disallowed in package names.
83 -- They should be considered deprecated and removed from this list once users
84 -- migrate to using the lowercase versions of the names.
85 List.elem name
86 [ "Easing"
87 , "LoadAssets"
88 , "elm-MultiDimArray"
89 , "elm-SafeLists"
90 , "GraphicsEngine"
91 , "Elm-Css"
92 , "Elm-Test"
93 , "DateOp"
94 , "IO"
95 , "Elm-Align-Distribute"
96 , "Elm-Format-String"
97 , "Elm-Multiset"
98 , "Elm-Random-Sampling"
99 , "ElmCache"
100 , "ExternalStorage"
101 , "IntRange"
102 ]
105validateProjectName :: String -> Either String String
106validateProjectName str =
107 if elem ('-','-') (zip str (tail str)) then
108 Left "There is a double dash -- in your package name. It must be a single dash."
110 else if elem '_' str then
111 Left "Underscores are not allowed in package names."
113 else if any Char.isUpper str && not (whitelistedUppercaseName str) then
114 Left "Upper case characters are not allowed in package names."
116 else if not (Char.isLetter (head str)) then
117 Left "Package names must start with a letter."
119 else
120 Right str
123instance Binary Name where
124 get = Name <$> get <*> get
125 put (Name user project) =
126 do put user
127 put project
130instance FromJSON Name where
131 parseJSON (String text) =
132 let
133 string = T.unpack text
134 in
135 case fromString string of
136 Left msg ->
137 fail ("Ran into an invalid package name: " ++ string ++ "\n\n" ++ msg)
139 Right name ->
140 return name
142 parseJSON _ =
143 fail "Project name must be a string."
146instance ToJSON Name where
147 toJSON name =
148 toJSON (toString name)
151-- PACKAGE VERSIONS
153data Version = Version
154 { _major :: Int
155 , _minor :: Int
156 , _patch :: Int
157 }
158 deriving (Eq, Ord)
161initialVersion :: Version
162initialVersion =
163 Version 1 0 0
165dummyVersion :: Version
166dummyVersion =
167 Version 0 0 0
170bumpPatch :: Version -> Version
171bumpPatch (Version major minor patch) =
172 Version major minor (patch + 1)
174bumpMinor :: Version -> Version
175bumpMinor (Version major minor _patch) =
176 Version major (minor + 1) 0
178bumpMajor :: Version -> Version
179bumpMajor (Version major _minor _patch) =
180 Version (major + 1) 0 0
183-- FILTERING
185filterLatest :: (Ord a) => (Version -> a) -> [Version] -> [Version]
186filterLatest characteristic versions =
187 map last (List.groupBy ((==) `on` characteristic) (List.sort versions))
190majorAndMinor :: Version -> (Int,Int)
191majorAndMinor (Version major minor _patch) =
192 (major, minor)
195-- CONVERSIONS
197versionToString :: Version -> String
198versionToString (Version major minor patch) =
199 show major ++ "." ++ show minor ++ "." ++ show patch
202versionFromString :: String -> Either String Version
203versionFromString string =
204 case splitNumbers string of
205 Just [major, minor, patch] ->
206 Right (Version major minor patch)
207 _ ->
208 Left "Must have format MAJOR.MINOR.PATCH (e.g. 1.0.2)"
209 where
210 splitNumbers :: String -> Maybe [Int]
211 splitNumbers ns =
212 case span Char.isDigit ns of
213 ("", _) ->
214 Nothing
216 (numbers, []) ->
217 Just [ read numbers ]
219 (numbers, '.':rest) ->
220 (read numbers :) <$> splitNumbers rest
222 _ ->
223 Nothing
226instance Binary Version where
227 get = Version <$> get <*> get <*> get
228 put (Version major minor patch) =
229 do put major
230 put minor
231 put patch
234instance FromJSON Version where
235 parseJSON (String text) =
236 let string = T.unpack text in
237 case versionFromString string of
238 Right v ->
239 return v
241 Left problem ->
242 fail $ unlines
243 [ "Ran into an invalid version number: " ++ string
244 , problem
245 ]
247 parseJSON _ =
248 fail "Version number must be stored as a string."
251instance ToJSON Version where
252 toJSON version =
253 toJSON (versionToString version)