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