git.iko.soy/elk
on c19392f help sign in
elk/src/Elm/Package.hs
320 lines 6.5 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Elm.Package
4 ( Name(..)
5 , Package(..)
6 , dummyName, core, browser, virtualDom, html, webgl, linearAlgebra
7 , toString, toText, toUrl, toFilePath
8 , fromText
9 , Version(..)
10 , initialVersion, dummyVersion
11 , bumpPatch, bumpMinor, bumpMajor
12 , filterLatest, majorAndMinor
13 , versionToString, versionToText, versionFromText
14 , decoder
15 , encode
16 , versionDecoder
17 , encodeVersion
18 )
19 where
22import Control.Monad (liftM, liftM2, liftM3)
23import Data.Binary (Binary, get, getWord8, put, putWord8)
24import qualified Data.Char as Char
25import Data.Function (on)
26import qualified Data.List as List
27import Data.Monoid ((<>))
28import qualified Data.Text as Text
29import qualified Data.Text.Read as Text
30import qualified Data.Text.Lazy as B (toStrict)
31import qualified Data.Text.Lazy.Builder as B (singleton, toLazyText)
32import qualified Data.Text.Lazy.Builder.Int as B (decimal)
33import Data.Text (Text)
34import Data.Word (Word16)
35import System.FilePath ((</>))
36import qualified Json.Decode as Decode
37import qualified Json.Encode as Encode
41-- PACKGE NAMES
44data Name =
45 Name
46 { _user :: !Text
47 , _project :: !Text
48 }
49 deriving (Eq, Ord)
52data Package =
53 Package
54 { _name :: !Name
55 , _version :: !Version
56 }
57 deriving (Eq, Ord)
60dummyName :: Name
61dummyName =
62 Name "user" "project"
65core :: Name
66core =
67 Name "elm-lang" "core"
70browser :: Name
71browser =
72 Name "elm-lang" "browser"
75virtualDom :: Name
76virtualDom =
77 Name "elm-lang" "virtual-dom"
80html :: Name
81html =
82 Name "elm-lang" "html"
85webgl :: Name
86webgl =
87 Name "elm-community" "webgl"
90linearAlgebra :: Name
91linearAlgebra =
92 Name "elm-community" "linear-algebra"
95toString :: Name -> String
96toString name =
97 Text.unpack (toText name)
100toText :: Name -> Text
101toText (Name user project) =
102 user <> "/" <> project
105toUrl :: Name -> String
106toUrl (Name user project) =
107 Text.unpack user ++ "/" ++ Text.unpack project
110toFilePath :: Name -> FilePath
111toFilePath (Name user project) =
112 Text.unpack user </> Text.unpack project
115fromText :: Text -> Either String Name
116fromText text =
117 case Text.splitOn "/" text of
118 [ user, project ] | not (Text.null user || Text.null project) ->
119 Name user <$> validateProjectName project
121 _ ->
122 Left "A valid project name looks like `user/project`"
125validateProjectName :: Text -> Either String Text
126validateProjectName text =
127 if Text.isInfixOf "--" text then
128 Left "There is a double dash -- in your package name. It must be a single dash."
130 else if Text.isInfixOf "_" text then
131 Left "Underscores are not allowed in package names."
133 else if Text.isInfixOf "." text then
134 Left "Dots are not allowed in package names."
136 else if Text.any Char.isUpper text then
137 Left "Upper case characters are not allowed in package names."
139 else if not (Char.isLetter (Text.head text)) then
140 Left "Package names must start with a letter."
142 else if Text.isSuffixOf "-" text then
143 Left "Package names cannot end with a dash."
145 else
146 Right text
150-- PACKAGE VERSIONS
153data Version =
154 Version
155 { _major :: {-# UNPACK #-} !Word16
156 , _minor :: {-# UNPACK #-} !Word16
157 , _patch :: {-# UNPACK #-} !Word16
158 }
159 deriving (Eq, Ord)
162initialVersion :: Version
163initialVersion =
164 Version 1 0 0
166dummyVersion :: Version
167dummyVersion =
168 Version 0 0 0
171bumpPatch :: Version -> Version
172bumpPatch (Version major minor patch) =
173 Version major minor (patch + 1)
176bumpMinor :: Version -> Version
177bumpMinor (Version major minor _patch) =
178 Version major (minor + 1) 0
181bumpMajor :: Version -> Version
182bumpMajor (Version major _minor _patch) =
183 Version (major + 1) 0 0
187-- FILTERING
190filterLatest :: (Ord a) => (Version -> a) -> [Version] -> [Version]
191filterLatest characteristic versions =
192 map last (List.groupBy ((==) `on` characteristic) (List.sort versions))
195majorAndMinor :: Version -> ( Int, Int )
196majorAndMinor (Version major minor _patch) =
197 ( fromIntegral major, fromIntegral minor )
201-- CONVERSIONS
204versionToString :: Version -> String
205versionToString version =
206 Text.unpack (versionToText version)
209versionToText :: Version -> Text
210versionToText (Version major minor patch) =
211 B.toStrict $ B.toLazyText $
212 B.decimal major
213 <> B.singleton '.'
214 <> B.decimal minor
215 <> B.singleton '.'
216 <> B.decimal patch
219versionFromText :: Text -> Either String Version
220versionFromText text =
221 case Text.splitOn "." text of
222 [major, minor, patch] ->
223 Version
224 <$> toNumber major
225 <*> toNumber minor
226 <*> toNumber patch
228 _ ->
229 Left "Must have format MAJOR.MINOR.PATCH (e.g. 1.0.2)"
232toNumber :: Text -> Either String Word16
233toNumber txt =
234 case Text.decimal txt of
235 Right (n, "") ->
236 Right n
238 _ ->
239 Left "Must have format MAJOR.MINOR.PATCH (e.g. 1.0.2)"
243-- BINARY
246instance Binary Name where
247 get =
248 liftM2 Name get get
250 put (Name user project) =
251 do put user
252 put project
255instance Binary Package where
256 get =
257 liftM2 Package get get
259 put (Package name version) =
260 do put name
261 put version
264instance Binary Version where
265 get =
266 do word <- getWord8
267 if word == 0
268 then liftM3 Version get get get
269 else
270 do minor <- liftM fromIntegral getWord8
271 patch <- liftM fromIntegral getWord8
272 return (Version (fromIntegral word) minor patch)
274 put (Version major minor patch) =
275 if major < 256 && minor < 256 && patch < 256 then
276 do putWord8 (fromIntegral major)
277 putWord8 (fromIntegral minor)
278 putWord8 (fromIntegral patch)
279 else
280 do putWord8 0
281 put major
282 put minor
283 put patch
287-- JSON
290decoder :: Decode.Decoder Name
291decoder =
292 do txt <- Decode.text
293 case fromText txt of
294 Left msg ->
295 Decode.fail $ "Expecting a PACKAGE name. " ++ msg
297 Right name ->
298 Decode.succeed name
301encode :: Name -> Encode.Value
302encode name =
303 Encode.text (toText name)
307versionDecoder :: Decode.Decoder Version
308versionDecoder =
309 do txt <- Decode.text
310 case versionFromText txt of
311 Right version ->
312 Decode.succeed version
314 Left msg ->
315 Decode.fail $ "Expecting a VERSION. " ++ msg
318encodeVersion :: Version -> Encode.Value
319encodeVersion version =
320 Encode.text (versionToText version)