git.iko.soy/elk
on e00a3f3 help sign in
elk/src/Elm/Package.hs
299 lines 6.1 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Elm.Package
4 ( Name(..)
5 , Package(..)
6 , dummyName, core, virtualDom, html
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"
70virtualDom :: Name
71virtualDom =
72 Name "elm-lang" "virtual-dom"
75html :: Name
76html =
77 Name "elm-lang" "html"
80toString :: Name -> String
81toString name =
82 Text.unpack (toText name)
85toText :: Name -> Text
86toText (Name user project) =
87 user <> "/" <> project
90toUrl :: Name -> String
91toUrl (Name user project) =
92 Text.unpack user ++ "/" ++ Text.unpack project
95toFilePath :: Name -> FilePath
96toFilePath (Name user project) =
97 Text.unpack user </> Text.unpack project
100fromText :: Text -> Either String Name
101fromText text =
102 case Text.splitOn "/" text of
103 [ user, project ] | not (Text.null user || Text.null project) ->
104 Name user <$> validateProjectName project
106 _ ->
107 Left "A valid project name looks like `user/project`"
110validateProjectName :: Text -> Either String Text
111validateProjectName text =
112 if Text.isInfixOf "--" text then
113 Left "There is a double dash -- in your package name. It must be a single dash."
115 else if Text.isInfixOf "_" text then
116 Left "Underscores are not allowed in package names."
118 else if Text.any Char.isUpper text then
119 Left "Upper case characters are not allowed in package names."
121 else if not (Char.isLetter (Text.head text)) then
122 Left "Package names must start with a letter."
124 else
125 Right text
129-- PACKAGE VERSIONS
132data Version =
133 Version
134 { _major :: {-# UNPACK #-} !Word16
135 , _minor :: {-# UNPACK #-} !Word16
136 , _patch :: {-# UNPACK #-} !Word16
137 }
138 deriving (Eq, Ord)
141initialVersion :: Version
142initialVersion =
143 Version 1 0 0
145dummyVersion :: Version
146dummyVersion =
147 Version 0 0 0
150bumpPatch :: Version -> Version
151bumpPatch (Version major minor patch) =
152 Version major minor (patch + 1)
155bumpMinor :: Version -> Version
156bumpMinor (Version major minor _patch) =
157 Version major (minor + 1) 0
160bumpMajor :: Version -> Version
161bumpMajor (Version major _minor _patch) =
162 Version (major + 1) 0 0
166-- FILTERING
169filterLatest :: (Ord a) => (Version -> a) -> [Version] -> [Version]
170filterLatest characteristic versions =
171 map last (List.groupBy ((==) `on` characteristic) (List.sort versions))
174majorAndMinor :: Version -> ( Int, Int )
175majorAndMinor (Version major minor _patch) =
176 ( fromIntegral major, fromIntegral minor )
180-- CONVERSIONS
183versionToString :: Version -> String
184versionToString version =
185 Text.unpack (versionToText version)
188versionToText :: Version -> Text
189versionToText (Version major minor patch) =
190 B.toStrict $ B.toLazyText $
191 B.decimal major
192 <> B.singleton '.'
193 <> B.decimal minor
194 <> B.singleton '.'
195 <> B.decimal patch
198versionFromText :: Text -> Either String Version
199versionFromText text =
200 case Text.splitOn "." text of
201 [major, minor, patch] ->
202 Version
203 <$> toNumber major
204 <*> toNumber minor
205 <*> toNumber patch
207 _ ->
208 Left "Must have format MAJOR.MINOR.PATCH (e.g. 1.0.2)"
211toNumber :: Text -> Either String Word16
212toNumber txt =
213 case Text.decimal txt of
214 Right (n, "") ->
215 Right n
217 _ ->
218 Left "Must have format MAJOR.MINOR.PATCH (e.g. 1.0.2)"
222-- BINARY
225instance Binary Name where
226 get =
227 liftM2 Name get get
229 put (Name user project) =
230 do put user
231 put project
234instance Binary Package where
235 get =
236 liftM2 Package get get
238 put (Package name version) =
239 do put name
240 put version
243instance Binary Version where
244 get =
245 do word <- getWord8
246 if word == 0
247 then liftM3 Version get get get
248 else
249 do minor <- liftM fromIntegral getWord8
250 patch <- liftM fromIntegral getWord8
251 return (Version (fromIntegral word) minor patch)
253 put (Version major minor patch) =
254 if major < 256 && minor < 256 && patch < 256 then
255 do putWord8 (fromIntegral major)
256 putWord8 (fromIntegral minor)
257 putWord8 (fromIntegral patch)
258 else
259 do putWord8 0
260 put major
261 put minor
262 put patch
266-- JSON
269decoder :: Decode.Decoder Name
270decoder =
271 do txt <- Decode.text
272 case fromText txt of
273 Left _ ->
274 Decode.fail "a valid project name, like \"elm-lang/core\""
276 Right name ->
277 Decode.succeed name
280encode :: Name -> Encode.Value
281encode name =
282 Encode.text (toText name)
286versionDecoder :: Decode.Decoder Version
287versionDecoder =
288 do txt <- Decode.text
289 case versionFromText txt of
290 Right version ->
291 Decode.succeed version
293 Left _ ->
294 Decode.fail "a version number, like 1.0.0"
297encodeVersion :: Version -> Encode.Value
298encodeVersion version =
299 Encode.text (versionToText version)