@@ -0,0 +1,187 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+module Elm.Package where
3+
4+import Control.Applicative ((<$>), (<*>))
5+import Control.Monad.Error.Class (MonadError, throwError)
6+import Data.Aeson
7+import Data.Binary
8+import qualified Data.List as List
9+import qualified Data.Text as T
10+import qualified Data.Maybe as Maybe
11+import System.FilePath ((</>))
12+import Data.Char (isDigit)
13+import Data.Function (on)
14+
15+data Name = Name
16+ { user :: String
17+ , project :: String
18+ }
19+ deriving (Eq, Ord)
20+
21+
22+dummyName :: Name
23+dummyName =
24+ Name "USER" "PROJECT"
25+
26+
27+coreName :: Name
28+coreName =
29+ Name "elm-lang" "core"
30+
31+
32+toString :: Name -> String
33+toString name =
34+ user name ++ "/" ++ project name
35+
36+
37+toUrl :: Name -> String
38+toUrl name =
39+ user name ++ "/" ++ project name
40+
41+
42+toFilePath :: Name -> FilePath
43+toFilePath name =
44+ user name </> project name
45+
46+
47+fromString :: String -> Maybe Name
48+fromString string =
49+ case break (=='/') string of
50+ ( user@(_:_), '/' : project@(_:_) )
51+ | all (/='/') project -> Just (Name user project)
52+ _ -> Nothing
53+
54+
55+fromString' :: (MonadError String m) => String -> m Name
56+fromString' string =
57+ Maybe.maybe (throwError $ errorMsg string) return (fromString string)
58+
59+
60+instance Binary Name where
61+ get = Name <$> get <*> get
62+ put (Name user project) =
63+ do put user
64+ put project
65+
66+
67+instance FromJSON Name where
68+ parseJSON (String text) =
69+ let string = T.unpack text in
70+ Maybe.maybe (fail $ errorMsg string) return (fromString string)
71+
72+ parseJSON _ = fail "Project name must be a string."
73+
74+
75+instance ToJSON Name where
76+ toJSON name =
77+ toJSON (toString name)
78+
79+
80+errorMsg :: String -> String
81+errorMsg string =
82+ unlines
83+ [ "Dependency file has an invalid name: " ++ string
84+ , "Must have format USER/PROJECT and match a public github project."
85+ ]
86+
87+
88+
89+
90+data Version = Version
91+ { major :: Int
92+ , minor :: Int
93+ , patch :: Int
94+ }
95+ deriving (Eq, Ord)
96+
97+
98+initialVersion :: Version
99+initialVersion =
100+ Version 1 0 0
101+
102+dummyVersion :: Version
103+dummyVersion =
104+ Version 0 0 0
105+
106+
107+bumpPatch :: Version -> Version
108+bumpPatch (Version major minor patch) =
109+ Version major minor (patch + 1)
110+
111+bumpMinor :: Version -> Version
112+bumpMinor (Version major minor _patch) =
113+ Version major (minor + 1) 0
114+
115+bumpMajor :: Version -> Version
116+bumpMajor (Version major _minor _patch) =
117+ Version (major + 1) 0 0
118+
119+
120+-- FILTERING
121+
122+filterLatest :: (Ord a) => (Version -> a) -> [Version] -> [Version]
123+filterLatest characteristic versions =
124+ map last (List.groupBy ((==) `on` characteristic) (List.sort versions))
125+
126+
127+majorAndMinor :: Version -> (Int,Int)
128+majorAndMinor (Version major minor _patch) =
129+ (major, minor)
130+
131+
132+-- CONVERSIONS
133+
134+versionToString :: Version -> String
135+versionToString (Version major minor patch) =
136+ show major ++ "." ++ show minor ++ "." ++ show patch
137+
138+
139+versionFromString :: String -> Maybe Version
140+versionFromString string =
141+ case splitNumbers string of
142+ Just [major, minor, patch] ->
143+ Just (Version major minor patch)
144+ _ -> Nothing
145+ where
146+ splitNumbers :: String -> Maybe [Int]
147+ splitNumbers ns =
148+ case span isDigit ns of
149+ ("", _) ->
150+ Nothing
151+
152+ (numbers, []) ->
153+ Just [ read numbers ]
154+
155+ (numbers, '.':rest) ->
156+ (read numbers :) <$> splitNumbers rest
157+
158+ _ -> Nothing
159+
160+
161+instance Binary Version where
162+ get = Version <$> get <*> get <*> get
163+ put (Version major minor patch) =
164+ do put major
165+ put minor
166+ put patch
167+
168+
169+instance FromJSON Version where
170+ parseJSON (String text) =
171+ let string = T.unpack text in
172+ case versionFromString string of
173+ Just v -> return v
174+ Nothing ->
175+ fail $ unlines
176+ [ "Dependency file has an invalid version number: " ++ string
177+ , "Must have format MAJOR.MINOR.PATCH (e.g. 0.1.2)"
178+ ]
179+
180+ parseJSON _ =
181+ fail "Version number must be stored as a string."
182+
183+
184+instance ToJSON Version where
185+ toJSON version =
186+ toJSON (versionToString version)
187+