diff --git a/elm-package.cabal b/elm-package.cabal --- a/elm-package.cabal +++ b/elm-package.cabal @@ -1,5 +1,5 @@ Name: elm-package -Version: 0.4 +Version: 0.5 Synopsis: Package manager for Elm libraries @@ -63,7 +63,7 @@ containers >= 0.3 && < 0.6, bytestring >= 0.9 && < 0.11, directory >= 1.0 && < 2.0, - elm-compiler >= 0.14.1 && < 0.15, + elm-compiler >= 0.15 && < 0.16, filepath >= 1 && < 2.0, HTTP >= 4000.2.5 && < 4000.3, http-client >= 0.3 && < 0.5, @@ -125,7 +125,7 @@ bytestring >= 0.9 && < 0.11, containers >= 0.3 && < 0.6, directory >= 1.0 && < 2.0, - elm-compiler >= 0.14 && < 0.15, + elm-compiler >= 0.15 && < 0.16, filepath >= 1 && < 2.0, HTTP >= 4000.2.5 && < 4000.3, http-client >= 0.3 && < 0.5, @@ -165,7 +165,7 @@ -- bytestring, -- containers, -- directory, --- elm-compiler >= 0.14 && < 0.15, +-- elm-compiler >= 0.15 && < 0.16, -- filepath, -- HTTP, -- HUnit, diff --git a/src/Catalog.hs b/src/Catalog.hs --- a/src/Catalog.hs +++ b/src/Catalog.hs @@ -66,8 +66,10 @@ Nothing -> [] Just time -> [("since", show time)] + newtype PackageSummary = PackageSummary (N.Name, [V.Version]) + instance Json.FromJSON PackageSummary where parseJSON (Json.Object obj) = do name <- obj .: "name" @@ -78,8 +80,6 @@ fail "package summary must be an object" - - register :: N.Name -> V.Version -> Manager.Manager () register name version = do url <- catalog "register" vars @@ -132,7 +132,7 @@ cacheDir N.toFilePath name V.toString version metadataPath exists <- liftIO (doesFileExist fullMetadataPath) - + content <- case exists of True -> liftIO (LBS.readFile fullMetadataPath) @@ -143,7 +143,7 @@ createDirectoryIfMissing True (dropFileName fullMetadataPath) LBS.writeFile fullMetadataPath (Client.responseBody response) return (Client.responseBody response) - + case Json.eitherDecode content of Right value -> return value Left err -> diff --git a/src/CommandLine/Arguments.hs b/src/CommandLine/Arguments.hs --- a/src/CommandLine/Arguments.hs +++ b/src/CommandLine/Arguments.hs @@ -13,6 +13,7 @@ import qualified Manager import qualified Publish import qualified Paths_elm_package as This +import qualified Elm.Compiler as Compiler import qualified Elm.Package.Name as N import qualified Elm.Package.Paths as Path import qualified Elm.Package.Version as V @@ -46,7 +47,7 @@ where top = "Elm Package Manager " ++ showVersion This.version - ++ ", (c) Evan Czaplicki 2013-2014\n" + ++ " (Elm Platform " ++ Compiler.version ++ ")\n" moreHelp = linesToDoc diff --git a/src/Diff.hs b/src/Diff.hs --- a/src/Diff.hs +++ b/src/Diff.hs @@ -31,7 +31,7 @@ maybeVersions <- Catalog.versions name latestVersion <- - maybe (throwError noVersions) (return . last) maybeVersions + maybe (throwError noVersions) (return . maximum) maybeVersions computeDiff name latestVersion newDocs Nothing diff --git a/src/Elm/Package/Constraint.hs b/src/Elm/Package/Constraint.hs --- a/src/Elm/Package/Constraint.hs +++ b/src/Elm/Package/Constraint.hs @@ -2,8 +2,10 @@ ( Constraint , fromString , toString - , minimalRangeFrom + , untilNextMajor + , untilNextMinor , expand + , defaultElmVersion , isSatisfied , errorMessage ) where @@ -25,22 +27,35 @@ -- CREATE CONSTRAINTS -minimalRangeFrom :: V.Version -> Constraint -minimalRangeFrom version = +untilNextMajor :: V.Version -> Constraint +untilNextMajor version = Range version LessOrEqual Less (V.bumpMajor version) +untilNextMinor :: V.Version -> Constraint +untilNextMinor version = + Range version LessOrEqual Less (V.bumpMinor version) + + expand :: Constraint -> V.Version -> Constraint expand constraint@(Range lower lowerOp upperOp upper) version | version < lower = Range version LessOrEqual upperOp upper - | version > upper = + | version > upper = Range lower lowerOp Less (V.bumpMajor version) | otherwise = constraint + +-- ELM CONSTRAINT + +defaultElmVersion :: Constraint +defaultElmVersion = + if V.major V.elm > 0 + then untilNextMajor V.elm + else untilNextMinor V.elm -- CHECK IF SATISFIED diff --git a/src/Elm/Package/Description.hs b/src/Elm/Package/Description.hs --- a/src/Elm/Package/Description.hs +++ b/src/Elm/Package/Description.hs @@ -29,6 +29,7 @@ { name :: N.Name , repo :: String , version :: V.Version + , elmVersion :: C.Constraint , summary :: String , license :: String , sourceDirs :: [FilePath] @@ -44,6 +45,7 @@ { name = N.Name "USER" "PROJECT" , repo = "https://github.com/USER/PROJECT.git" , version = V.initialVersion + , elmVersion = C.defaultElmVersion , summary = "helpful summary of your project, less than 80 characters" , license = "BSD3" , sourceDirs = [ "." ] @@ -57,34 +59,22 @@ read :: (MonadIO m, MonadError String m) => FilePath -> m Description read path = - do json <- liftIO (BS.readFile path) - case eitherDecode json of - Left err -> throwError $ "Error reading file " ++ path ++ ":\n " ++ err - Right ds -> return ds + do json <- liftIO (BS.readFile path) + case eitherDecode json of + Left err -> + throwError $ "Error reading file " ++ path ++ ":\n " ++ err + Right ds -> + return ds + -- WRITE write :: Description -> IO () write description = BS.writeFile Path.description json where - json = prettyAngles (prettyJSON description) - - -prettyAngles :: BS.ByteString -> BS.ByteString -prettyAngles string = - BS.concat $ replaceChunks string - where - replaceChunks str = - let (before, after) = BS.break (=='\\') str - in - case BS.take 6 after of - "\\u003e" -> before : ">" : replaceChunks (BS.drop 6 after) - "\\u003c" -> before : "<" : replaceChunks (BS.drop 6 after) - "" -> [before] - _ -> - before : "\\" : replaceChunks (BS.tail after) + json = prettyJSON description -- FIND MODULE FILE PATHS @@ -131,7 +121,7 @@ prettyJSON :: Description -> BS.ByteString prettyJSON description = - encodePretty' config description + prettyAngles (encodePretty' config description) where config = defConfig { confCompare = keyOrder (normalKeys ++ dependencyKeys) } @@ -145,6 +135,7 @@ , "exposed-modules" , "native-modules" , "dependencies" + , "elm-version" ] dependencyKeys = @@ -154,17 +145,33 @@ |> map (T.pack . N.toString) +prettyAngles :: BS.ByteString -> BS.ByteString +prettyAngles string = + BS.concat $ replaceChunks string + where + replaceChunks str = + let (before, after) = BS.break (=='\\') str + in + case BS.take 6 after of + "\\u003e" -> before : ">" : replaceChunks (BS.drop 6 after) + "\\u003c" -> before : "<" : replaceChunks (BS.drop 6 after) + "" -> [before] + _ -> + before : "\\" : replaceChunks (BS.tail after) + + instance ToJSON Description where toJSON d = object $ - [ "repository" .= repo d - , "version" .= version d - , "summary" .= summary d - , "license" .= license d - , "source-directories" .= sourceDirs d - , "exposed-modules" .= exposed d - , "dependencies" .= jsonDeps (dependencies d) - ] ++ if natives d then ["native-modules" .= True] else [] + [ "repository" .= repo d + , "version" .= version d + , "summary" .= summary d + , "license" .= license d + , "source-directories" .= sourceDirs d + , "exposed-modules" .= exposed d + , "dependencies" .= jsonDeps (dependencies d) + , "elm-version" .= elmVersion d + ] ++ if natives d then ["native-modules" .= True] else [] where jsonDeps deps = Map.fromList $ map (first (T.pack . N.toString)) deps @@ -174,6 +181,8 @@ parseJSON (Object obj) = do version <- get obj "version" "your projects version number" + elmVersion <- getElmVersion obj + summary <- get obj "summary" "a short summary of your project" when (length summary >= 80) $ fail "'summary' must be less than 80 characters" @@ -193,7 +202,7 @@ natives <- maybe False id <$> obj .:? "native-modules" - return $ Description name repo version summary license sourceDirs exposed natives deps + return $ Description name repo version elmVersion summary license sourceDirs exposed natives deps parseJSON _ = mzero @@ -203,22 +212,45 @@ get obj field desc = do maybe <- obj .:? field case maybe of - Just value -> return value - Nothing -> fail $ "Missing field " ++ show field ++ ", " ++ desc ++ ".\n" ++ - " Check out an example " ++ Path.description ++ " file here:" ++ - " " + Just value -> + return value + Nothing -> + fail $ + "Missing field " ++ show field ++ ", " ++ desc ++ ".\n" ++ + " Check out an example " ++ Path.description ++ " file here:\n" ++ + " " + getDependencies :: Object -> Parser [(N.Name, C.Constraint)] getDependencies obj = - toDeps =<< get obj "dependencies" "a listing of your project's dependencies" - where - toDeps deps = - forM (Map.toList deps) $ \(f, c) -> - case (N.fromString f, C.fromString c) of - (Just name, Just constr) -> return (name, constr) - (Nothing, _) -> fail $ N.errorMsg f - (_, Nothing) -> fail $ C.errorMessage c + do deps <- get obj "dependencies" "a listing of your project's dependencies" + forM (Map.toList deps) $ \(rawName, rawConstraint) -> + case (N.fromString rawName, C.fromString rawConstraint) of + (Just name, Just constraint) -> + return (name, constraint) + + (Nothing, _) -> + fail (N.errorMsg rawName) + + (_, Nothing) -> + fail (C.errorMessage rawConstraint) + + +getElmVersion :: Object -> Parser C.Constraint +getElmVersion obj = + do rawConstraint <- get obj "elm-version" elmVersionDescription + case C.fromString rawConstraint of + Just constraint -> + return constraint + Nothing -> + fail (C.errorMessage rawConstraint) + + +elmVersionDescription :: String +elmVersionDescription = + "acceptable versions of the Elm Platform (e.g. \"" + ++ C.toString C.defaultElmVersion ++ "\")" repoToName :: String -> Either String N.Name diff --git a/src/Elm/Package/Version.hs b/src/Elm/Package/Version.hs --- a/src/Elm/Package/Version.hs +++ b/src/Elm/Package/Version.hs @@ -8,8 +8,23 @@ import qualified Data.List as List import qualified Data.Text as T -elmVersion :: Version -elmVersion = error "Package.Version.elmVersion" +import qualified Elm.Compiler as Elm + + +elm :: Version +elm = + case Elm.rawVersion of + major : minor : patch : _ -> + Version major minor patch + + [major, minor] -> + Version major minor 0 + + [major] -> + Version major 0 0 + + [] -> + error "could not detect version of elm-compiler you are using" data Version = Version diff --git a/src/Install.hs b/src/Install.hs --- a/src/Install.hs +++ b/src/Install.hs @@ -67,7 +67,7 @@ if approve then runPlan newSolution plan - else liftIO $ putStrLn "Okay, I did not change anything!" + else liftIO $ putStrLn "Okay, I did not change anything!" getApproval :: Bool -> Plan.Plan -> IO Bool @@ -144,7 +144,7 @@ ++ showDependency name constraint ++ "\n\n" ++ "You probably want one of the following constraints instead:\n\n " ++ Constraint.toString (Constraint.expand constraint version) ++ "\n " - ++ Constraint.toString (Constraint.minimalRangeFrom version) ++ "\n" + ++ Constraint.toString (Constraint.untilNextMajor version) ++ "\n" addNewDependency :: Bool -> N.Name -> V.Version -> Desc.Description -> Manager.Manager Desc.Description @@ -167,7 +167,7 @@ return newDescription where newConstraint = - Constraint.minimalRangeFrom version + Constraint.untilNextMajor version newConstraints = (name, newConstraint) : Desc.dependencies description @@ -199,7 +199,7 @@ do let core = N.Name "elm-lang" "core" version <- latestVersion core let desc = Desc.defaultDescription { - Desc.dependencies = [ (core, Constraint.minimalRangeFrom version) ] + Desc.dependencies = [ (core, Constraint.untilNextMajor version) ] } liftIO (Desc.write desc) return desc diff --git a/src/Install/Solver.hs b/src/Install/Solver.hs --- a/src/Install/Solver.hs +++ b/src/Install/Solver.hs @@ -67,19 +67,24 @@ exploreVersion :: N.Name -> V.Version -> S.Solution -> Packages -> Explorer (Maybe S.Solution) exploreVersion name version solution remainingPackages = - do constraints <- Store.getConstraints name version + do (elmVersion, constraints) <- Store.getConstraints name version + if C.isSatisfied elmVersion V.elm + then explore constraints + else return Nothing - let (overlappingConstraints, newConstraints) = - List.partition (\(name, _) -> Map.member name solution) constraints + where + explore constraints = + do let (overlappingConstraints, newConstraints) = + List.partition (\(name, _) -> Map.member name solution) constraints - case all (satisfiedBy solution) overlappingConstraints of - False -> return Nothing - True -> - do maybePackages <- addConstraints remainingPackages newConstraints - case maybePackages of - Nothing -> return Nothing - Just extendedPackages -> - explorePackages (Map.insert name version solution) extendedPackages + case all (satisfiedBy solution) overlappingConstraints of + False -> return Nothing + True -> + do maybePackages <- addConstraints remainingPackages newConstraints + case maybePackages of + Nothing -> return Nothing + Just extendedPackages -> + explorePackages (Map.insert name version solution) extendedPackages satisfiedBy :: S.Solution -> (N.Name, C.Constraint) -> Bool diff --git a/src/Store.hs b/src/Store.hs --- a/src/Store.hs +++ b/src/Store.hs @@ -25,9 +25,11 @@ , versionCache :: VersionCache } + type ConstraintCache = - Map.Map (N.Name, V.Version) [(N.Name, C.Constraint)] + Map.Map (N.Name, V.Version) (C.Constraint, [(N.Name, C.Constraint)]) + type VersionCache = Map.Map N.Name [V.Version] @@ -47,7 +49,7 @@ readVersionCache = do cacheDirectory <- asks Manager.cacheDirectory - let versionsFile = cacheDirectory "versions.json" + let versionsFile = cacheDirectory "versions.dat" let lastUpdatedPath = cacheDirectory "last-updated" now <- liftIO Time.getCurrentTime @@ -86,7 +88,7 @@ :: (MonadIO m, MonadReader Manager.Environment m, MonadState Store m, MonadError String m) => N.Name -> V.Version - -> m [(N.Name, C.Constraint)] + -> m (C.Constraint, [(N.Name, C.Constraint)]) getConstraints name version = do cache <- gets constraintCache @@ -94,7 +96,7 @@ Just constraints -> return constraints Nothing -> do desc <- Catalog.description name version - let constraints = Desc.dependencies desc + let constraints = (Desc.elmVersion desc, Desc.dependencies desc) modify $ \store -> store { constraintCache =