git.iko.soy/elk
on 00a3069 help sign in
elk/src/Elm/Package.hs
349 lines 6.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Elm.Package
4 ( Name(..)
5 , Package(..)
6 , isKernel
7 , toString, toText, toUrl, toFilePath
8 , fromText
9 , dummyName, kernel, core
10 , browser, virtualDom, html
11 , webgl, linearAlgebra
12 , Version(..)
13 , initialVersion, dummyVersion
14 , bumpPatch, bumpMinor, bumpMajor
15 , filterLatest, majorAndMinor
16 , versionToString, versionToText, versionFromText
17 , decoder
18 , encode
19 , versionDecoder
20 , encodeVersion
21 )
22 where
25import Control.Monad (liftM, liftM2, liftM3)
26import Data.Binary (Binary, get, getWord8, put, putWord8)
27import qualified Data.Char as Char
28import Data.Function (on)
29import qualified Data.List as List
30import Data.Monoid ((<>))
31import qualified Data.Text as Text
32import qualified Data.Text.Read as Text
33import qualified Data.Text.Lazy as B (toStrict)
34import qualified Data.Text.Lazy.Builder as B (singleton, toLazyText)
35import qualified Data.Text.Lazy.Builder.Int as B (decimal)
36import Data.Text (Text)
37import Data.Word (Word16)
38import System.FilePath ((</>))
39import qualified Json.Decode.Internals as Decode
40import qualified Json.Encode as Encode
44-- PACKGE NAMES
47data Name =
48 Name
49 { _user :: !Text
50 , _project :: !Text
51 }
52 deriving (Eq, Ord)
55data Package =
56 Package
57 { _name :: !Name
58 , _version :: !Version
59 }
60 deriving (Eq, Ord)
64-- HELPERS
67isKernel :: Name -> Bool
68isKernel (Name user _) =
69 user == "elm-lang" || user == "elm-explorations"
72toString :: Name -> String
73toString name =
74 Text.unpack (toText name)
77toText :: Name -> Text
78toText (Name user project) =
79 user <> "/" <> project
82toUrl :: Name -> String
83toUrl (Name user project) =
84 Text.unpack user ++ "/" ++ Text.unpack project
87toFilePath :: Name -> FilePath
88toFilePath (Name user project) =
89 Text.unpack user </> Text.unpack project
92fromText :: Text -> Either String Name
93fromText text =
94 case Text.splitOn "/" text of
95 [ user, project ] | not (Text.null user || Text.null project) ->
96 Name user <$> validateProjectName project
98 _ ->
99 Left "A valid project name looks like `user/project`"
102validateProjectName :: Text -> Either String Text
103validateProjectName text =
104 if Text.isInfixOf "--" text then
105 Left "There is a double dash -- in your package name. It must be a single dash."
107 else if Text.isInfixOf "_" text then
108 Left "Underscores are not allowed in package names."
110 else if Text.isInfixOf "." text then
111 Left "Dots are not allowed in package names."
113 else if Text.any Char.isUpper text then
114 Left "Upper case characters are not allowed in package names."
116 else if not (Char.isLetter (Text.head text)) then
117 Left "Package names must start with a letter."
119 else if Text.isSuffixOf "-" text then
120 Left "Package names cannot end with a dash."
122 else
123 Right text
127-- COMMON PACKAGE NAMES
130{-# NOINLINE dummyName #-}
131dummyName :: Name
132dummyName =
133 Name "user" "project"
136{-# NOINLINE kernel #-}
137kernel :: Name
138kernel =
139 Name "elm-lang" "kernel"
142{-# NOINLINE core #-}
143core :: Name
144core =
145 Name "elm-lang" "core"
148{-# NOINLINE browser #-}
149browser :: Name
150browser =
151 Name "elm-lang" "browser"
154{-# NOINLINE virtualDom #-}
155virtualDom :: Name
156virtualDom =
157 Name "elm-lang" "virtual-dom"
160{-# NOINLINE html #-}
161html :: Name
162html =
163 Name "elm-lang" "html"
166{-# NOINLINE webgl #-}
167webgl :: Name
168webgl =
169 Name "elm-community" "webgl"
172{-# NOINLINE linearAlgebra #-}
173linearAlgebra :: Name
174linearAlgebra =
175 Name "elm-community" "linear-algebra"
179-- PACKAGE VERSIONS
182data Version =
183 Version
184 { _major :: {-# UNPACK #-} !Word16
185 , _minor :: {-# UNPACK #-} !Word16
186 , _patch :: {-# UNPACK #-} !Word16
187 }
188 deriving (Eq, Ord)
191initialVersion :: Version
192initialVersion =
193 Version 1 0 0
195dummyVersion :: Version
196dummyVersion =
197 Version 0 0 0
200bumpPatch :: Version -> Version
201bumpPatch (Version major minor patch) =
202 Version major minor (patch + 1)
205bumpMinor :: Version -> Version
206bumpMinor (Version major minor _patch) =
207 Version major (minor + 1) 0
210bumpMajor :: Version -> Version
211bumpMajor (Version major _minor _patch) =
212 Version (major + 1) 0 0
216-- FILTERING
219filterLatest :: (Ord a) => (Version -> a) -> [Version] -> [Version]
220filterLatest characteristic versions =
221 map last (List.groupBy ((==) `on` characteristic) (List.sort versions))
224majorAndMinor :: Version -> ( Int, Int )
225majorAndMinor (Version major minor _patch) =
226 ( fromIntegral major, fromIntegral minor )
230-- CONVERSIONS
233versionToString :: Version -> String
234versionToString version =
235 Text.unpack (versionToText version)
238versionToText :: Version -> Text
239versionToText (Version major minor patch) =
240 B.toStrict $ B.toLazyText $
241 B.decimal major
242 <> B.singleton '.'
243 <> B.decimal minor
244 <> B.singleton '.'
245 <> B.decimal patch
248versionFromText :: Text -> Either String Version
249versionFromText text =
250 case Text.splitOn "." text of
251 [major, minor, patch] ->
252 Version
253 <$> toNumber major
254 <*> toNumber minor
255 <*> toNumber patch
257 _ ->
258 Left "Must have format MAJOR.MINOR.PATCH (e.g. 1.0.2)"
261toNumber :: Text -> Either String Word16
262toNumber txt =
263 case Text.decimal txt of
264 Right (n, "") ->
265 Right n
267 _ ->
268 Left "Must have format MAJOR.MINOR.PATCH (e.g. 1.0.2)"
272-- BINARY
275instance Binary Name where
276 get =
277 liftM2 Name get get
279 put (Name user project) =
280 do put user
281 put project
284instance Binary Package where
285 get =
286 liftM2 Package get get
288 put (Package name version) =
289 do put name
290 put version
293instance Binary Version where
294 get =
295 do word <- getWord8
296 if word == 0
297 then liftM3 Version get get get
298 else
299 do minor <- liftM fromIntegral getWord8
300 patch <- liftM fromIntegral getWord8
301 return (Version (fromIntegral word) minor patch)
303 put (Version major minor patch) =
304 if major < 256 && minor < 256 && patch < 256 then
305 do putWord8 (fromIntegral major)
306 putWord8 (fromIntegral minor)
307 putWord8 (fromIntegral patch)
308 else
309 do putWord8 0
310 put major
311 put minor
312 put patch
316-- JSON
319decoder :: Decode.Decoder String Name
320decoder =
321 do txt <- Decode.text
322 case fromText txt of
323 Left msg ->
324 Decode.fail msg
326 Right name ->
327 Decode.succeed name
330encode :: Name -> Encode.Value
331encode name =
332 Encode.text (toText name)
336versionDecoder :: Decode.Decoder String Version
337versionDecoder =
338 do txt <- Decode.text
339 case versionFromText txt of
340 Right version ->
341 Decode.succeed version
343 Left msg ->
344 Decode.fail msg
347encodeVersion :: Version -> Encode.Value
348encodeVersion version =
349 Encode.text (versionToText version)