packages feed

elm-package (empty) → 0.2

raw patch · 31 files changed

+3159/−0 lines, 31 filesdep +HTTPdep +HUnitdep +aesonsetup-changed

Dependencies added: HTTP, HUnit, aeson, aeson-pretty, ansi-wl-pprint, base, binary, bytestring, containers, directory, elm-compiler, filepath, http-client, http-client-tls, http-types, json, mtl, network, optparse-applicative, pretty, process, resourcet, test-framework, test-framework-hunit, text, time, unordered-containers, vector, zip-archive

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013-2014, Evan Czaplicki++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Evan Czaplicki nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ elm-package.cabal view
@@ -0,0 +1,186 @@+Name: elm-package+Version: 0.2++Synopsis:+    Package manager for Elm libraries+Description:+    elm-package is a package manager that lets you install, update, and+    publish Elm libraries.++Homepage:+    http://github.com/elm-lang/elm-package++License: BSD3+License-file: LICENSE++Author:     Evan Czaplicki+Maintainer: info@elm-lang.org+Copyright:  Copyright: (c) 2013-2014 Evan Czaplicki++Category: Language++Build-type: Simple+Cabal-version: >=1.9++source-repository head+    type:     git+    location: git://github.com/elm-lang/elm-package.git++Library+    ghc-options:+        -threaded -O2 -W++    Hs-Source-Dirs:+        src++    exposed-modules:+        Elm.Package.Constraint,+        Elm.Package.Description,+        Elm.Package.Initialize,+        Elm.Package.Name,+        Elm.Package.Paths,+        Elm.Package.Solution,+        Elm.Package.Version,+        GitHub++    other-modules:+        Catalog,+        CommandLine.Helpers,+        Install,+        Install.Fetch,+        Install.Plan,+        Install.Solver,+        Manager,+        Paths_elm_package,+        Store,+        Utils.Http++    Build-depends:+        aeson >= 0.7 && < 0.9,+        aeson-pretty >= 0.7 && < 0.8,+        base >=4.2 && <5,+        binary >= 0.7 && < 0.8,+        containers >= 0.3 && < 0.6,+        bytestring >= 0.9 && < 0.11,+        directory >= 1.0 && < 2.0,+        elm-compiler >= 0.14 && < 0.15,+        filepath >= 1 && < 2.0,+        HTTP >= 4000.2.5 && < 4000.3,+        http-client >= 0.3 && < 0.4,+        http-client-tls >= 0.2 && < 0.3,+        http-types >= 0.7 && < 0.9,+        mtl >= 2 && < 3,+        network >= 2.4 && < 2.7,+        process >= 1 && < 2,+        text,+        time,+        unordered-containers,+        vector >= 0.10 && < 0.11,+        zip-archive+++Executable elm-package+    ghc-options:+        -threaded -O2 -W++    Hs-Source-Dirs:+        src++    Main-is:+        Main.hs++    other-modules:+        Bump,+        Catalog,+        CommandLine.Arguments,+        CommandLine.Helpers,+        Diff,+        Diff.Compare,+        Diff.Display,+        Docs,+        Elm.Package.Constraint,+        Elm.Package.Description,+        Elm.Package.Initialize,+        Elm.Package.Name,+        Elm.Package.Paths,+        Elm.Package.Solution,+        Elm.Package.Version,+        GitHub,+        Install,+        Install.Fetch,+        Install.Plan,+        Install.Solver,+        Manager,+        Publish,+        Store,+        Utils.Http,+        Utils.Paths++    Build-depends:+        aeson >= 0.7 && < 0.9,+        aeson-pretty >= 0.7 && < 0.8,+        ansi-wl-pprint >= 0.6 && < 0.7,+        base >=4.2 && <5,+        binary >= 0.7 && < 0.8,+        bytestring >= 0.9 && < 0.11,+        containers >= 0.3 && < 0.6,+        directory >= 1.0 && < 2.0,+        elm-compiler >= 0.14 && < 0.15,+        filepath >= 1 && < 2.0,+        HTTP >= 4000.2.5 && < 4000.3,+        http-client >= 0.3 && < 0.4,+        http-client-tls >= 0.2 && < 0.3,+        http-types >= 0.7 && < 0.9,+        mtl >= 2 && < 3,+        network >= 2.4 && < 2.7,+        optparse-applicative >= 0.8.1 && < 0.11,+        pretty,+        process >= 1 && < 2,+        text,+        time,+        unordered-containers,+        vector >= 0.10 && < 0.11,+        zip-archive++Test-suite unit-test+    Type:+        exitcode-stdio-1.0++    Hs-Source-Dirs:+        tests, src++    Main-is:+        Tests.hs++    Other-modules:+        SolverTests++    Build-depends:+        aeson,+        aeson-pretty,+        ansi-wl-pprint,+        base >=4.2 && <5,+        binary,+        bytestring,+        containers,+        directory,+        elm-compiler >= 0.14 && < 0.15,+        filepath,+        HTTP,+        HUnit,+        http-client >= 0.3,+        http-client-tls,+        http-types,+        json,+        mtl,+        network,+        optparse-applicative,+        pretty,+        process,+        resourcet,+        test-framework,+        test-framework-hunit,+        text,+        time,+        unordered-containers,+        vector
+ src/Bump.hs view
@@ -0,0 +1,218 @@+module Bump where++import Control.Monad.Error (throwError, liftIO)+import qualified Data.List as List++import qualified Catalog+import qualified CommandLine.Helpers as Cmd+import qualified Diff.Compare as Compare+import qualified Docs+import qualified Elm.Docs as Docs+import qualified Elm.Package.Description as Desc+import qualified Elm.Package.Name as N+import qualified Elm.Package.Paths as Path+import qualified Elm.Package.Version as V+import qualified Manager+++bump :: Manager.Manager ()+bump =+    do  description <- Desc.read Path.description+        let name = Desc.name description+        let statedVersion = Desc.version description++        newDocs <- Docs.generate description++        maybeVersions <- Catalog.versions name+        case maybeVersions of+            Nothing -> +                validateInitialVersion description++            Just publishedVersions ->+                let bumps = map (\(old, _, _) -> old) (validBumps publishedVersions) in+                if statedVersion `elem` bumps+                    then suggestVersion newDocs name statedVersion description+                    else throwError (unbumpable bumps)++        return ()+++unbumpable :: [V.Version] -> String+unbumpable validBumps =+    unlines+    [ "To bump you must start with an already published version number in"+    , Path.description ++ ", giving us a starting point to bump from."+    , ""+    , "The version numbers that can be bumped include the following subset of"+    , "published versions:"+    , "  " ++ List.intercalate ", " (map V.toString validBumps)+    , ""+    , "Switch back to one of these versions before running 'elm-package bump'"+    , "again."+    ]+++data Validity+    = Valid+    | Invalid+    | Changed V.Version+++validateInitialVersion :: Desc.Description -> Manager.Manager Validity+validateInitialVersion description =+    do  Cmd.out explanation+        if Desc.version description == V.initialVersion+            then Cmd.out goodMsg >> return Valid+            else changeVersion badMsg description V.initialVersion+    where+        explanation =+            unlines+            [ "This package has never been published before. Here's how things work:"+            , ""+            , "  * Versions all have exactly three parts: MAJOR.MINOR.PATCH"+            , ""+            , "  * All packages start with initial version " ++ V.toString V.initialVersion+            , ""+            , "  * Versions are incremented based on how the API changes:"+            , ""+            , "        PATCH - the API is the same, no risk of breaking code"+            , "        MINOR - values have been added, existing values are unchanged"+            , "        MAJOR - existing values have been changed or removed"+            , ""+            , "  * I will bump versions for you, automatically enforcing these rules"+            , ""+            ]++        goodMsg =+            "The version number in " ++ Path.description ++ " is correct so you are all set!"++        badMsg =+            concat+            [ "It looks like the version in " ++ Path.description ++ " has been changed though!\n"+            , "Would you like me to change it back to " ++ V.toString V.initialVersion ++ "? (y/n) "+            ]+++changeVersion :: String -> Desc.Description -> V.Version -> Manager.Manager Validity+changeVersion explanation description newVersion = +    do  liftIO $ putStr explanation+        yes <- liftIO Cmd.yesOrNo+        case yes of+            False -> do+                Cmd.out "Okay, no changes were made."+                return Invalid++            True -> do+                liftIO $ Desc.write (description { Desc.version = newVersion })+                Cmd.out $ "Version changed to " ++ V.toString newVersion ++ "."+                return (Changed newVersion)+++suggestVersion+    :: [Docs.Documentation]+    -> N.Name+    -> V.Version+    -> Desc.Description+    -> Manager.Manager Validity+suggestVersion newDocs name version description =+    do  changes <- Compare.computeChanges newDocs name version+        let newVersion = Compare.bumpBy changes version+        changeVersion (infoMsg changes newVersion) description newVersion++    where+        infoMsg changes newVersion =+            let old = V.toString version+                new = V.toString newVersion+                magnitude = show (Compare.packageChangeMagnitude changes)+            in+            concat+            [ "Based on your new API, this should be a ", magnitude, " change (", old, " => ", new, ")\n"+            , "Bail out of this command and run 'elm-package diff' for a full explanation.\n"+            , "\n"+            , "Should I perform the update (", old, " => ", new, ") in ", Path.description, "? (y/n) "+            ]+++validateVersion+    :: [Docs.Documentation]+    -> N.Name+    -> V.Version+    -> [V.Version]+    -> Manager.Manager Validity+validateVersion newDocs name statedVersion publishedVersions =+    case List.find (\(_ ,new, _) -> statedVersion == new) bumps of+        Nothing ->+          let isPublished = statedVersion `elem` publishedVersions+          in+              throwError (if isPublished then alreadyPublished else invalidBump)++        Just (old, new, magnitude) ->+            do  changes <- Compare.computeChanges newDocs name old+                let realNew = Compare.bumpBy changes old+                case new == realNew of+                    False ->+                        throwError (badBump old new realNew magnitude changes)+                    True -> do+                        Cmd.out (looksGood old new magnitude)+                        return Valid++    where+        bumps = validBumps publishedVersions++        looksGood old new magnitude =+            "Version number " ++ V.toString new ++ " verified (" ++ show magnitude+            ++ " change, " ++ V.toString old ++ " => " ++ V.toString new ++ ")"++        alreadyPublished =+            "Version " ++ V.toString statedVersion+            ++ " has already been published, but you are trying to publish\n"+            ++ "it again! Run the following command to see what the new version should be.\n"+            ++ "\n    elm-package bump\n"++        invalidBump =+            unlines+            [ "The version listed in " ++ Path.description ++ " is neither a previously"+            , "published version, nor a valid version bump."+            , ""+            , "Set the version number in " ++ Path.description ++ " to the released version"+            , "that you are improving upon. If you are working on the latest API, that means"+            , "you are modifying version " ++ V.toString (last publishedVersions) ++ "."+            , ""+            , "From there, we can compute which version comes next based on the API changes"+            , "when you run the following command."+            , ""+            , "    elm-package bump"+            ]++        badBump old new realNew magnitude changes =+            unlines+            [ "It looks like you are trying to bump from version " ++ V.toString old ++ " to " ++ V.toString new ++ "."+            , "This implies you are making a " ++ show magnitude ++ " change, but when we compare"+            , "the " ++ V.toString old ++ " API to the API you have now it seems that it should"+            , "really be a " ++ show (Compare.packageChangeMagnitude changes) ++ " change (" ++ V.toString realNew ++ ")."+            , ""+            , "Run the following command to see the API diff we are working from:"+            , ""+            , "    elm-package diff " ++ V.toString old+            , ""+            , "The easiest way to bump versions is to let us do it automatically. If you set"+            , "the version number in " ++ Path.description ++ " to the released version"+            , "that you are improving upon, we will compute which version should come next"+            , "when you run:"+            , ""+            , "    elm-package bump"+            ]+++-- VALID BUMPS++validBumps :: [V.Version] -> [(V.Version, V.Version, Compare.Magnitude)]+validBumps publishedVersions =+    [ (majorPoint, V.bumpMajor majorPoint, Compare.MAJOR) ]+    ++ map (\v -> (v, V.bumpMinor v, Compare.MINOR)) minorPoints+    ++ map (\v -> (v, V.bumpPatch v, Compare.PATCH)) patchPoints+  where+    patchPoints = V.filterLatest V.majorAndMinor publishedVersions+    minorPoints = V.filterLatest V.major publishedVersions+    majorPoint = last publishedVersions+
+ src/Catalog.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+module Catalog where++import Control.Monad.Error (MonadError, throwError)+import Control.Monad.RWS (MonadIO, liftIO, MonadReader, asks)+import Data.Aeson ((.:))+import qualified Data.Aeson as Json+import qualified Data.Binary as Binary+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Time.Clock as Time+import Data.Version (showVersion)+import Network.HTTP+import qualified Network.HTTP.Client as Client+import qualified Network.HTTP.Client.MultipartFormData as Multi+import System.Directory (createDirectoryIfMissing, doesFileExist)+import System.FilePath ((</>), dropFileName)++import qualified Elm.Docs as Docs+import qualified Elm.Package.Description as Desc+import qualified Elm.Package.Name as N+import qualified Elm.Package.Paths as P+import qualified Elm.Package.Version as V+import qualified Manager+import qualified Paths_elm_package as This+import qualified Utils.Http as Http+++catalog+    :: (MonadIO m, MonadReader Manager.Environment m, MonadError String m)+    => String+    -> [(String,String)]+    -> m String+catalog path vars =+  do  domain <- asks Manager.catalog+      return $ domain ++ "/" ++ path ++ "?" ++ urlEncodeVars (version : vars)+  where+    version = ("elm-package-version", showVersion This.version)+++versions :: N.Name -> Manager.Manager (Maybe [V.Version])+versions name =+  do  url <- catalog "versions" [("name", N.toString name)]+      Http.send url $ \request manager -> do+          response <- Client.httpLbs request manager+          return $ Binary.decode $ Client.responseBody response+++allPackages+    :: (MonadIO m, MonadReader Manager.Environment m, MonadError String m)+    => Maybe Time.UTCTime+    -> m (Maybe [(N.Name, [V.Version])])+allPackages maybeTime =+  do  url <- catalog "all-packages" vars+      Http.send url $ \request manager -> do+          response <- Client.httpLbs request manager+          case Json.eitherDecode (Client.responseBody response) of+            Left _ ->+              return Nothing++            Right summaries ->+              return $ Just $ map (\(PackageSummary s) -> s) summaries+  where+    vars =+      case maybeTime of+        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"+          versions <- obj .: "versions"+          return (PackageSummary (name, versions))++    parseJSON _ =+      fail "package summary must be an object"+++++register :: N.Name -> V.Version -> Manager.Manager ()+register name version =+  do  url <- catalog "register" vars+      Http.send url $ \request manager -> do+          request' <- Multi.formDataBody files request+          let request'' = request' { Client.responseTimeout = Nothing }+          Client.httpLbs request'' manager+          return ()+  where+    vars =+        [ ("name", N.toString name)+        , ("version", V.toString version)+        ]++    files =+        [ Multi.partFileSource "documentation" P.documentation+        , Multi.partFileSource "description" P.description+        , Multi.partFileSource "readme" "README.md"+        ]+++description+    :: (MonadIO m, MonadReader Manager.Environment m, MonadError String m)+    => N.Name+    -> V.Version+    -> m Desc.Description+description name version =+  getJson "description" P.description name version+++documentation+    :: (MonadIO m, MonadReader Manager.Environment m, MonadError String m)+    => N.Name+    -> V.Version+    -> m [Docs.Documentation]+documentation name version =+  getJson "documentation" "documentation.json" name version+++getJson+    :: (MonadIO m, MonadReader Manager.Environment m, MonadError String m, Json.FromJSON a)+    => String+    -> FilePath+    -> N.Name+    -> V.Version+    -> m a+getJson metadata metadataPath name version =+  do  cacheDir <- asks Manager.cacheDirectory+      let fullMetadataPath =+            cacheDir </> N.toFilePath name </> V.toString version </> metadataPath++      exists <- liftIO (doesFileExist fullMetadataPath)+      +      content <-+        case exists of+          True -> liftIO (LBS.readFile fullMetadataPath)+          False ->+            do  url <- catalog metadata [("name", N.toString name), ("version", V.toString version)]+                Http.send url $ \request manager ->+                    do  response <- Client.httpLbs request manager+                        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 ->+          throwError $+            "Unable to get " ++ metadataPath ++ " for "+            ++ N.toString name ++ " " ++ V.toString version ++ "\n" ++ err
+ src/CommandLine/Arguments.hs view
@@ -0,0 +1,186 @@+module CommandLine.Arguments (parse) where++import Control.Applicative (pure, optional, (<$>), (<*>), (<|>))+import Control.Monad.Error (throwError)+import Data.Monoid ((<>), mconcat, mempty)+import Data.Version (showVersion)+import qualified Options.Applicative as Opt+import qualified Text.PrettyPrint.ANSI.Leijen as PP++import qualified Bump+import qualified Diff+import qualified Install+import qualified Manager+import qualified Publish+import qualified Paths_elm_package as This+import qualified Elm.Package.Name as N+import qualified Elm.Package.Paths as Path+import qualified Elm.Package.Version as V+++parse :: IO (Manager.Manager ())+parse =+    Opt.customExecParser preferences parser+++preferences :: Opt.ParserPrefs+preferences =+    Opt.prefs (mempty <> Opt.showHelpOnError)+++parser :: Opt.ParserInfo (Manager.Manager ())+parser =+    Opt.info (Opt.helper <*> commands) infoModifier+++-- GENERAL HELP++infoModifier :: Opt.InfoMod (Manager.Manager ())+infoModifier =+    mconcat+        [ Opt.fullDesc+        , Opt.header top+        , Opt.progDesc "install and publish elm libraries"+        , Opt.footerDoc (Just moreHelp)+        ]+  where+    top =+        "Elm Package Manager " ++ showVersion This.version+        ++ ", (c) Evan Czaplicki 2013-2014\n"++    moreHelp =+        linesToDoc+        [ "To learn more about a particular command run:"+        , "    elm-package COMMAND --help"+        ]+++linesToDoc :: [String] -> PP.Doc+linesToDoc lines =+    PP.vcat (map PP.text lines)+++-- COMMANDS++commands :: Opt.Parser (Manager.Manager ())+commands =+    Opt.hsubparser commandOptions+  where+    version =+        Opt.flag' (error "temporarily out of order")+            (Opt.long "version" <> Opt.short 'v' <> Opt.hidden)++    commandOptions =+        mconcat+        [ Opt.command "install" installInfo+        , Opt.command "publish" publishInfo+        , Opt.command "bump" bumpInfo+        , Opt.command "diff" diffInfo+        ]+++-- BUMP++bumpInfo :: Opt.ParserInfo (Manager.Manager ())+bumpInfo =+    Opt.info (pure Bump.bump) $+        mconcat+        [ Opt.fullDesc+        , Opt.progDesc "Bump version numbers based on API changes"+        ]+++-- DIFF++diffInfo :: Opt.ParserInfo (Manager.Manager ())+diffInfo =+    Opt.info (Diff.diff <$> range) $+        mconcat+        [ Opt.fullDesc+        , Opt.progDesc "Get differences between two APIs"+        ]+  where+    range =+        (Diff.Between <$> package <*> version <*> version)+        <|> (Diff.Since <$> version)+        <|> (pure Diff.LatestVsActual)+++-- PUBLISH++publishInfo :: Opt.ParserInfo (Manager.Manager ())+publishInfo =+    Opt.info (pure Publish.publish) $+        mconcat+        [ Opt.fullDesc+        , Opt.progDesc "Publish your package to the central catalog"+        ]+++-- INSTALL++installInfo :: Opt.ParserInfo (Manager.Manager ())+installInfo =+    Opt.info args infoModifier+  where+    args =+        installWith <$> optional package <*> optional version <*> yes++    installWith maybeName maybeVersion autoYes =+        case (maybeName, maybeVersion) of+          (Nothing, Nothing) ->+              Install.install autoYes Install.Everything++          (Just name, Nothing) ->+              Install.install autoYes (Install.Latest name)++          (Just name, Just version) ->+              Install.install autoYes (Install.Exactly name version)++          (Nothing, Just version) ->+              throwError $+                "You specified a version number, but not a package!\nVersion "+                ++ V.toString version ++ " of what?"++    infoModifier =+        mconcat+        [ Opt.fullDesc+        , Opt.progDesc "Install packages to use locally"+        , Opt.footerDoc (Just examples)+        ]++    examples =+        linesToDoc+        [ "Examples:"+        , "  elm-package install                        # everything needed by " ++ Path.description+        , "  elm-package install evancz/elm-html        # any version"+        , "  elm-package install evancz/elm-html 1.2.0  # specific version"+        ]+++-- ARGUMENT PARSERS++package :: Opt.Parser N.Name+package =+    Opt.argument N.fromString $+        mconcat+        [ Opt.metavar "PACKAGE"+        , Opt.help "A specific package name (e.g. evancz/automaton)"+        ]++version :: Opt.Parser V.Version+version =+    Opt.argument V.fromString $+        mconcat+        [ Opt.metavar "VERSION"+        , Opt.help "Specific version of a package (e.g. 1.2.0)"+        ]++yes :: Opt.Parser Bool+yes =+    Opt.switch $+        mconcat+        [ Opt.long "yes"+        , Opt.short 'y'+        , Opt.help "Reply 'yes' to all automated prompts."+        ]
+ src/CommandLine/Helpers.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE FlexibleContexts #-}+module CommandLine.Helpers where++import Control.Monad.Error+import System.Directory+import System.IO++import qualified Elm.Utils as Utils+++yesOrNo :: IO Bool+yesOrNo =+  do  hFlush stdout+      input <- getLine+      case input of+        "y" -> return True+        "n" -> return False+        _   -> do putStr "Must type 'y' for yes or 'n' for no: "+                  yesOrNo+++inDir :: (MonadError String m, MonadIO m) => FilePath -> m a -> m a+inDir dir doStuff =+  do  here <- liftIO $ getCurrentDirectory+      liftIO $ createDirectoryIfMissing True dir+      liftIO $ setCurrentDirectory dir+      result <- doStuff+      liftIO $ setCurrentDirectory here+      return result+++git :: (MonadError String m, MonadIO m) => [String] -> m String+git = run "git"+++run :: (MonadError String m, MonadIO m) => String -> [String] -> m String+run = Utils.run+++out :: (MonadIO m) => String -> m ()+out string =+    liftIO $ hPutStrLn stdout string'+  where+    string' =+        if not (null string) && last string == '\n' then init string else string+
+ src/Diff.hs view
@@ -0,0 +1,70 @@+module Diff where++import Control.Monad.Error (throwError)++import qualified Catalog+import qualified CommandLine.Helpers as Cmd+import qualified Diff.Compare as Compare+import qualified Diff.Display as Display+import qualified Docs+import qualified Elm.Docs as Docs+import qualified Elm.Package.Description as Desc+import qualified Elm.Package.Name as N+import qualified Elm.Package.Paths as Path+import qualified Elm.Package.Version as V+import qualified Manager+++data Range+    = LatestVsActual+    | Since V.Version+    | Between N.Name V.Version V.Version+++diff :: Range -> Manager.Manager ()+diff range =+    case range of+        LatestVsActual ->+            do  desc <- Desc.read Path.description+                let name = Desc.name desc+                newDocs <- Docs.generate desc++                maybeVersions <- Catalog.versions name+                latestVersion <-+                    maybe (throwError noVersions) (return . last) maybeVersions++                computeDiff name latestVersion newDocs Nothing++        Since version ->+            do  desc <- Desc.read Path.description+                newDocs <- Docs.generate desc+                computeDiff (Desc.name desc) version newDocs Nothing++        Between name old new ->+            do  newDocs <- Catalog.documentation name new+                computeDiff name old newDocs (Just new)+++noVersions :: String+noVersions =+    "This package has not been published, there is nothing to diff against!"+++computeDiff+    :: N.Name+    -> V.Version+    -> [Docs.Documentation]+    -> Maybe V.Version+    -> Manager.Manager ()+computeDiff name oldVersion newDocs maybeNewVersion =+    do  Cmd.out msg+        changes <- Compare.computeChanges newDocs name oldVersion+        Cmd.out (Display.packageChanges changes)+    where+        msg =+            "Comparing " ++ N.toString name ++ " " ++ V.toString oldVersion ++ " to " ++ newStuff ++ "..."++        newStuff =+            case maybeNewVersion of+                Nothing -> "local changes"+                Just version -> V.toString version
+ src/Diff/Compare.hs view
@@ -0,0 +1,312 @@+module Diff.Compare where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (zipWithM)+import Data.Function (on)+import qualified Data.List as List+import qualified Data.Map as Map+import qualified Data.Set as Set++import qualified Catalog+import qualified Elm.Compiler.Module as Module+import qualified Elm.Compiler.Type as Type+import qualified Elm.Docs as Docs+import qualified Elm.Package.Name as N+import qualified Elm.Package.Version as V+import qualified Manager+++computeChanges+    :: [Docs.Documentation]+    -> N.Name+    -> V.Version+    -> Manager.Manager PackageChanges+computeChanges newDocs name version =+    do  oldDocs <- Catalog.documentation name version+        return (diffPackages oldDocs newDocs)+++-- CHANGE MAGNITUDE++data Magnitude+    = PATCH+    | MINOR+    | MAJOR+    deriving (Eq, Ord, Show)+++bumpBy :: PackageChanges -> V.Version -> V.Version+bumpBy changes version =+    case packageChangeMagnitude changes of+      PATCH -> V.bumpPatch version+      MINOR -> V.bumpMinor version+      MAJOR -> V.bumpMajor version+++packageChangeMagnitude :: PackageChanges -> Magnitude+packageChangeMagnitude pkgChanges =+    maximum (added : removed : map moduleChangeMagnitude moduleChanges)+  where+    moduleChanges =+        Map.elems (modulesChanged pkgChanges)++    removed =+        if null (modulesRemoved pkgChanges)+            then PATCH+            else MAJOR++    added =+        if null (modulesAdded pkgChanges)+            then PATCH+            else MINOR++moduleChangeMagnitude :: ModuleChanges -> Magnitude+moduleChangeMagnitude moduleChanges =+    maximum+        [ changeMagnitude (adtChanges moduleChanges)+        , changeMagnitude (aliasChanges moduleChanges)+        , changeMagnitude (valueChanges moduleChanges)+        ]++changeMagnitude :: Changes k v -> Magnitude+changeMagnitude (Changes added changed removed)+    | Map.size removed > 0 = MAJOR+    | Map.size changed > 0 = MAJOR+    | Map.size added   > 0 = MINOR+    | otherwise            = PATCH+++-- DETECT CHANGES++data PackageChanges = PackageChanges+    { modulesAdded :: [String]+    , modulesChanged :: Map.Map String ModuleChanges+    , modulesRemoved :: [String]+    }++data ModuleChanges = ModuleChanges+    { adtChanges :: Changes String ([String], Map.Map String [Type.Type])+    , aliasChanges :: Changes String ([String], Type.Type)+    , valueChanges :: Changes String Type.Type+    }++data Changes k v = Changes+    { added :: Map.Map k v+    , changed :: Map.Map k (v,v)+    , removed :: Map.Map k v+    }+++diffPackages :: [Docs.Documentation] -> [Docs.Documentation] -> PackageChanges+diffPackages oldDocs newDocs =+    PackageChanges+        (Map.keys added)+        (filterOutPatches (Map.map (uncurry diffModule) changed))+        (Map.keys removed)+  where+    filterOutPatches chngs =+        Map.filter (\chng -> moduleChangeMagnitude chng /= PATCH) chngs++    (Changes added changed removed) =+        getChanges+            (\_ _ -> False)+            (docsToModules oldDocs)+            (docsToModules newDocs)+++data Module = Module+    { adts :: Map.Map String ([String], Map.Map String [Type.Type])+    , aliases :: Map.Map String ([String], Type.Type)+    , values :: Map.Map String Type.Type+    }+++docsToModules :: [Docs.Documentation] -> Map.Map String Module+docsToModules docs =+    Map.fromList (map docToModule docs)+++docToModule :: Docs.Documentation -> (String, Module)+docToModule (Docs.Documentation name _ aliases' unions' values') =+    (,) (Module.nameToString name) $ Module+    { adts =+        Map.fromList $ flip map unions' $ \union ->+            ( Docs.unionName union+            , (Docs.unionArgs union, Map.fromList (Docs.unionCases union))+            )++    , aliases =+        Map.fromList $ flip map aliases' $ \alias ->+            (Docs.aliasName alias, (Docs.aliasArgs alias, Docs.aliasType alias))++    , values =+        Map.fromList $ flip map values' $ \value ->+            (Docs.valueName value, Docs.valueType value)+    }+++diffModule :: Module -> Module -> ModuleChanges+diffModule (Module adts aliases values) (Module adts' aliases' values') =+    ModuleChanges+        (getChanges isEquivalentAdt adts adts')+        (getChanges isEquivalentType aliases aliases')+        (getChanges (\t t' -> isEquivalentType ([],t) ([],t')) values values')+++getChanges :: (Ord k) => (v -> v -> Bool) -> Map.Map k v -> Map.Map k v -> Changes k v+getChanges isEquivalent old new =+    Changes+    { added =+        Map.difference new old+    , changed =+        Map.filter+            (not . uncurry isEquivalent)+            (Map.intersectionWith (,) old new)+    , removed =+        Map.difference old new+    }+++isEquivalentAdt+    :: ([String], Map.Map String [Type.Type])+    -> ([String], Map.Map String [Type.Type])+    -> Bool+isEquivalentAdt (oldVars, oldCtors) (newVars, newCtors) =+    Map.size oldCtors == Map.size newCtors+    && and (zipWith (==) (Map.keys oldCtors) (Map.keys newCtors))+    && and (Map.elems (Map.intersectionWith equiv oldCtors newCtors))+  where+    equiv :: [Type.Type] -> [Type.Type] -> Bool+    equiv oldTypes newTypes =+        let allEquivalent =+                zipWith+                  isEquivalentType+                  (map ((,) oldVars) oldTypes)+                  (map ((,) newVars) newTypes)+        in+            length oldTypes == length newTypes+            && and allEquivalent+++isEquivalentType :: ([String], Type.Type) -> ([String], Type.Type) -> Bool+isEquivalentType (oldVars, oldType) (newVars, newType) =+    case diffType oldType newType of+      Nothing -> False+      Just renamings ->+          length oldVars == length newVars+          && isEquivalentRenaming (zip oldVars newVars ++ renamings)+++-- TYPES++diffType :: Type.Type -> Type.Type -> Maybe [(String,String)]+diffType oldType newType =+    case (oldType, newType) of+      (Type.Var oldName, Type.Var newName) ->+          Just [(oldName, newName)]++      (Type.Type oldName, Type.Type newName) ->+          if oldName == newName+              then Just []+              else Nothing++      (Type.Lambda a b, Type.Lambda a' b') ->+          (++)+              <$> diffType a a'+              <*> diffType b b'++      (Type.App t ts, Type.App t' ts') ->+          if length ts /= length ts'+            then Nothing+            else+                (++)+                    <$> diffType t t'+                    <*> (concat <$> zipWithM diffType ts ts')++      (Type.Record fields maybeExt, Type.Record fields' maybeExt') ->+          case (maybeExt, maybeExt') of+            (Nothing, Just _) -> Nothing+            (Just _, Nothing) -> Nothing+            (Nothing, Nothing) -> diffFields fields fields'+            (Just ext, Just ext') ->+                (++)+                    <$> diffType ext ext'+                    <*> diffFields fields fields'++      (_, _) ->+          Nothing+++diffFields :: [(String, Type.Type)] -> [(String, Type.Type)] -> Maybe [(String,String)]+diffFields rawFields rawFields'+    | length rawFields /= length rawFields' = Nothing+    | or (zipWith ((/=) `on` fst) fields fields') = Nothing+    | otherwise =+        concat <$> zipWithM (diffType `on` snd) fields fields'+    where+      fields  = sort rawFields+      fields' = sort rawFields'++      sort =+          List.sortBy (compare `on` fst)+++-- TYPE VARIABLES++isEquivalentRenaming :: [(String,String)] -> Bool+isEquivalentRenaming varPairs =+    case mapM verify renamings of+      Nothing -> False+      Just verifiedRenamings ->+          allUnique (map snd verifiedRenamings)+  where+    renamings =+        Map.toList (foldr insert Map.empty varPairs)++    insert (old,new) dict =+        Map.insertWith (++) old [new] dict++    verify (old, news) =+        case news of+          [] -> Nothing+          new : rest ->+              if all (new ==) rest+                  then Just (old, new)+                  else Nothing++    allUnique list =+        length list == Set.size (Set.fromList list)+++compatableVars :: String -> String -> Bool+compatableVars old new =+    case (categorizeVar old, categorizeVar new) of+      (Comparable, Comparable) -> True+      (Appendable, Appendable) -> True+      (Number    , Number    ) -> True++      (Comparable, Appendable) -> True+      (Number    , Comparable) -> True++      (_, Var) -> True++      (_, _) -> False+++data TypeVarCategory+    = Comparable+    | Appendable+    | Number+    | Var+++categorizeVar :: String -> TypeVarCategory+categorizeVar varName+    | any (/= '\'') primes = Var+    | name == "comparable" = Comparable+    | name == "appendable" = Appendable+    | name == "number"     = Number+    | otherwise            = Var+    where+      (name, primes) =+          break (=='\'') varName
+ src/Diff/Display.hs view
@@ -0,0 +1,182 @@+module Diff.Display (packageChanges) where++import Data.Char (isDigit)+import qualified Data.Map as Map+import Text.PrettyPrint ((<+>), (<>))+import qualified Text.PrettyPrint as P++import qualified Elm.Compiler.Type as Type+import qualified Diff.Compare as D+++packageChanges :: D.PackageChanges -> String+packageChanges pkgChanges@(D.PackageChanges added changed removed) =+    "This is a " ++ show (D.packageChangeMagnitude pkgChanges) ++ " change.\n\n"+    ++ showAdded+    ++ showRemoved+    ++ showChanged+  where+    showRemoved+        | null removed = ""+        | otherwise =+            "------ Removed modules - MAJOR ------\n"+            ++ concatMap ("\n    " ++) removed+            ++ "\n\n\n"++    showAdded+        | null added = ""+        | otherwise =+            "------ Added modules - MINOR ------\n"+            ++ concatMap ("\n    " ++) added+            ++ "\n\n\n"++    showChanged+        | Map.null changed = ""+        | otherwise =+            concatMap moduleChanges (Map.toList changed)+++moduleChanges :: (String, D.ModuleChanges) -> String+moduleChanges (name, changes) =+    "------ Changes to module " ++ name ++ " - " ++ show magnitude ++ " ------"+    ++ display "Added" adtAdd aliasAdd valueAdd+    ++ display "Removed" adtRemove aliasRemove valueRemove+    ++ display "Changed" adtChange aliasChange valueChange+    ++ "\n\n\n"+  where+    magnitude =+        D.moduleChangeMagnitude changes++    (adtAdd, adtChange, adtRemove) =+        changesToDocs adtDoc (D.adtChanges changes)++    (aliasAdd, aliasChange, aliasRemove) =+        changesToDocs aliasDoc (D.aliasChanges changes)++    (valueAdd, valueChange, valueRemove) =+        changesToDocs valueDoc (D.valueChanges changes)+++changesToDocs :: (k -> v -> P.Doc) -> D.Changes k v -> ([P.Doc], [P.Doc], [P.Doc])+changesToDocs toDoc (D.Changes added changed removed) =+    ( map indented (Map.toList added)+    , map diffed   (Map.toList changed)+    , map indented (Map.toList removed)+    )+  where+    indented (name, value) =+        P.text "        " <> toDoc name value++    diffed (name, (oldValue, newValue)) =+        P.vcat+        [ P.text "      - " <> toDoc name oldValue+        , P.text "      + " <> toDoc name newValue+        , P.text ""+        ]+++display :: String -> [P.Doc] -> [P.Doc] -> [P.Doc] -> String+display categoryName adts aliases values+    | null (adts ++ aliases ++ values) = ""+    | otherwise =+        P.renderStyle (P.style { P.lineLength = 80 }) $+        P.vcat $+            P.text "" : P.text category : adts ++ aliases ++ values+    where+      category =+          "\n    " ++ categoryName ++ ":"+++-- PRETTY PRINTING++adtDoc :: String -> ([String], Map.Map String [Type.Type]) -> P.Doc+adtDoc name (tvars, ctors) =+    P.hang setup 4 (P.sep (zipWith (<+>) separators ctorDocs))+  where+    setup =+        P.text "type" <+> P.text name <+> P.hsep (map P.text tvars)++    separators =+        map P.text ("=" : repeat "|")++    ctorDocs =+        map ctorDoc (Map.toList ctors)++    ctorDoc (ctor, tipes) =+        P.hsep (P.text ctor : map parenDoc tipes)+++aliasDoc :: String -> ([String], Type.Type) -> P.Doc+aliasDoc name (tvars, tipe) =+    P.hang (setup <+> P.equals) 4 (typeDoc tipe)+  where+    setup =+        P.text "type" <+> P.text "alias" <+> P.text name <+> P.hsep (map P.text tvars)+++valueDoc :: String -> Type.Type -> P.Doc+valueDoc name tipe =+    P.text name <+> P.colon <+> typeDoc tipe+++parenDoc = generalTypeDoc True+typeDoc = generalTypeDoc False++generalTypeDoc :: Bool -> Type.Type -> P.Doc+generalTypeDoc parens tipe =+    case tipe of+      Type.Var x -> P.text x++      Type.Type name -> P.text name++      Type.Lambda t t' ->+          let (args, result) = collectLambdas [t] t'+          in+              (if parens then P.parens else id) $+              foldr arrow (typeDoc result) args++      Type.App t ts ->+          case t : ts of+            [ Type.Type name, tipe ]+              | name == "_List" ->+                  P.lbrack <> typeDoc tipe <> P.rbrack+                  +            Type.Type name : types+              | take 6 name == "_Tuple" && all isDigit (drop 6 name) ->+                  P.parens (P.hsep (P.punctuate P.comma (map typeDoc types)))++            types ->+                (if parens then P.parens else id) $+                P.hsep (map parenDoc types)++      Type.Record fields maybeExt ->+          P.sep [ P.hang start 2 fieldDocs, P.rbrace ]+        where+          start =+              case maybeExt of+                Nothing -> P.lbrace+                Just ext -> P.lbrace <+> typeDoc ext <+> P.text "|"++          fieldDocs =+              P.sep (P.punctuate P.comma (map fieldDoc fields))++          fieldDoc (name, tipe) =+              P.text name <+> P.colon <+> typeDoc tipe+++arrow :: Type.Type -> P.Doc -> P.Doc+arrow arg result =+    argDoc <+> P.text "->" <+> result+  where+    argDoc =+        case arg of+          Type.Lambda _ _ -> P.parens (typeDoc arg)+          _ -> typeDoc arg+++collectLambdas :: [Type.Type] -> Type.Type -> ([Type.Type], Type.Type)+collectLambdas args result =+    case result of+      Type.Lambda t t' -> collectLambdas (t:args) t'+      _ -> (reverse args, result)+
+ src/Docs.hs view
@@ -0,0 +1,44 @@+module Docs where++import Control.Monad (forM)+import Control.Monad.Error (liftIO, throwError)+import qualified Data.Aeson as Json+import qualified Data.ByteString.Lazy.Char8 as BS+import System.Directory (createDirectoryIfMissing)+import System.FilePath (dropFileName)++import qualified CommandLine.Helpers as Cmd+import qualified Elm.Docs as Docs+import qualified Elm.Package.Description as Desc+import qualified Elm.Package.Paths as Path+import qualified Manager+++generate :: Desc.Description -> Manager.Manager [Docs.Documentation]+generate description =+    do  exposedModules <- Desc.locateExposedModules description++        chunks <-+            forM (prep exposedModules) $ \(seperator, path) ->+                do  json <- Cmd.run "elm-doc" [path]+                    return (seperator ++ json)++        let json = BS.pack (concat chunks ++ "\n]")++        case Json.eitherDecode json of+          Left err ->+            throwError $ "Error generating documentation:\n" ++ err++          Right docs ->+            do  liftIO $ do+                    createDirectoryIfMissing True (dropFileName Path.documentation)+                    BS.writeFile Path.documentation json+                return docs+++prep exposedModules =+    zip ("[\n" : repeat ",\n") (map snd exposedModules)++++
+ src/Elm/Package/Constraint.hs view
@@ -0,0 +1,148 @@+module Elm.Package.Constraint+    ( Constraint+    , fromString+    , toString+    , minimalRangeFrom+    , expand+    , isSatisfied+    , errorMessage+    ) where++import qualified Data.Aeson as Json+import qualified Data.Text as Text++import qualified Elm.Package.Version as V+++-- CONSTRAINTS++data Constraint+    = Range V.Version Op Op V.Version+++data Op = Less | LessOrEqual+++-- CREATE CONSTRAINTS++minimalRangeFrom :: V.Version -> Constraint+minimalRangeFrom version =+  Range version LessOrEqual Less (V.bumpMajor version)+++expand :: Constraint -> V.Version -> Constraint+expand constraint@(Range lower lowerOp upperOp upper) version+  | version < lower =+      Range version LessOrEqual upperOp upper++  | version > upper = +      Range lower lowerOp Less (V.bumpMajor version)++  | otherwise =+      constraint++++-- CHECK IF SATISFIED++isSatisfied :: Constraint -> V.Version -> Bool+isSatisfied constraint version =+  case constraint of+    Range lower lowerOp upperOp upper ->+        isLess lowerOp lower version+          &&+        isLess upperOp version upper+++isLess :: (Ord a) => Op -> (a -> a -> Bool)+isLess op =+  case op of+    Less -> (<)+    LessOrEqual -> (<=)+++-- STRING CONVERSION++toString :: Constraint -> String+toString constraint =+  case constraint of+    Range lower lowerOp upperOp upper ->+      unwords+        [ V.toString lower+        , opToString lowerOp+        , "v"+        , opToString upperOp+        , V.toString upper+        ]+++opToString :: Op -> String+opToString op =+  case op of+    Less -> "<"+    LessOrEqual -> "<="+++fromString :: String -> Maybe Constraint+fromString str =+  do  let (lowerString, rest) = break (==' ') str+      lower <- V.fromString lowerString+      (lowerOp, rest1) <- takeOp (eatSpace rest)+      rest2 <- eatV (eatSpace rest1)+      (upperOp, rest3) <- takeOp (eatSpace rest2)+      upper <- V.fromString (eatSpace rest3)+      return (Range lower lowerOp upperOp upper)+++eatSpace :: String -> String+eatSpace str =+  case str of+    ' ' : rest -> rest+    _ -> str+++takeOp :: String -> Maybe (Op, String)+takeOp str =+  case str of+    '<' : '=' : rest -> Just (LessOrEqual, rest)+    '<' : rest -> Just (Less, rest)+    _ -> Nothing+++eatV :: String -> Maybe String+eatV str =+  case str of+    'v' : rest -> Just rest+    _ -> Nothing++++-- JSON CONVERSION++instance Json.ToJSON Constraint where+    toJSON constraint =+        Json.toJSON (toString constraint)+++instance Json.FromJSON Constraint where+    parseJSON (Json.String text) =+        let rawConstraint = Text.unpack text in+        case fromString rawConstraint of+          Just constraint ->+              return constraint++          Nothing ->+              fail $ errorMessage rawConstraint++    parseJSON _ =+        fail "constraint must be a string that looks something like \"1.2.1 <= v < 2.0.0\"."+++errorMessage :: String -> String+errorMessage rawConstraint =+    "Invalid constraint \"" ++ rawConstraint ++ "\"\n\n"+    ++ "    It should look something like \"1.2.1 <= v < 2.0.0\", with no extra or\n"+    ++ "    missing spaces. The middle letter needs to be a 'v' as well.\n\n"+    ++ "    Upper and lower bounds are required so that bounds represent the maximum range\n"+    ++ "    known to work. You do not want to promise users your library will work with\n"+    ++ "    4.0.0 that version has not been tested!"
+ src/Elm/Package/Description.hs view
@@ -0,0 +1,246 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+module Elm.Package.Description where++import Prelude hiding (read)+import Control.Applicative ((<$>))+import Control.Arrow (first)+import Control.Monad.Error (MonadError, throwError, MonadIO, liftIO, when, mzero, forM)+import Data.Aeson+import Data.Aeson.Types (Parser)+import Data.Aeson.Encode.Pretty (encodePretty', defConfig, confCompare, keyOrder)+import qualified Data.ByteString.Lazy.Char8 as BS+import qualified Data.HashMap.Strict as Map+import qualified Data.List as List+import qualified Data.Maybe as Maybe+import qualified Data.Text as T+import System.FilePath ((</>), (<.>))+import System.Directory (doesFileExist)++import qualified Elm.Compiler.Module as Module+import qualified Elm.Package.Name as N+import qualified Elm.Package.Version as V+import qualified Elm.Package.Constraint as C+import qualified Elm.Package.Paths as Path+import Elm.Utils ((|>))+++data Description = Description+    { name :: N.Name+    , repo :: String+    , version :: V.Version+    , summary :: String+    , license :: String+    , sourceDirs :: [FilePath]+    , exposed :: [Module.Name]+    , natives :: Bool+    , dependencies :: [(N.Name, C.Constraint)]+    }+++defaultDescription :: Description+defaultDescription =+    Description+    { name = N.Name "USER" "PROJECT"+    , repo = "https://github.com/USER/PROJECT.git"+    , version = V.initialVersion+    , summary = "helpful summary of your project, less than 80 characters"+    , license = "BSD3"+    , sourceDirs = [ "." ]+    , exposed = []+    , natives = False+    , dependencies = []+    }+++-- READ++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+++-- 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)+++-- FIND MODULE FILE PATHS++locateExposedModules :: (MonadIO m, MonadError String m) => Description -> m [(Module.Name, FilePath)]+locateExposedModules desc =+    mapM locate (exposed desc)+  where+    locate modul =+      let path = Module.nameToPath modul <.> "elm"+          dirs = sourceDirs desc+      in+      do  possibleLocations <-+              forM dirs $ \dir -> do+                  exists <- liftIO $ doesFileExist (dir </> path)+                  return (if exists then Just (dir </> path) else Nothing)++          case Maybe.catMaybes possibleLocations of+            [] ->+                throwError $+                unlines+                [ "Could not find exposed module '" ++ Module.nameToString modul ++ "' when looking through"+                , "the following source directories:"+                , concatMap ("\n    " ++) dirs+                , ""+                , "You may need to add a source directory to your " ++ Path.description ++ " file."+                ]++            [location] ->+                return (modul, location)++            locations ->+                throwError $+                unlines+                [ "I found more than one module named '" ++ Module.nameToString modul ++ "' in the"+                , "following locations:"+                , concatMap ("\n    " ++) locations+                , ""+                , "Module names must be unique within your package."+                ]+++-- JSON++prettyJSON :: Description -> BS.ByteString+prettyJSON description =+    encodePretty' config description+  where+    config =+        defConfig { confCompare = keyOrder (normalKeys ++ dependencyKeys) }++    normalKeys =+        [ "version"+        , "summary"+        , "repository"+        , "license"+        , "source-directories"+        , "exposed-modules"+        , "native-modules"+        , "dependencies"+        ]++    dependencyKeys =+        dependencies description+          |> map fst+          |> List.sort+          |> map (T.pack . N.toString)+++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 []+    where+      jsonDeps deps =+          Map.fromList $ map (first (T.pack . N.toString)) deps+++instance FromJSON Description where+    parseJSON (Object obj) =+        do  version <- get obj "version" "your projects version number"++            summary <- get obj "summary" "a short summary of your project"+            when (length summary >= 80) $+                fail "'summary' must be less than 80 characters"++            license <- get obj "license" "license information (BSD3 is recommended)"++            repo <- get obj "repository" "a link to the project's GitHub repo"+            name <- case repoToName repo of+                      Left err -> fail err+                      Right nm -> return nm++            exposed <- get obj "exposed-modules" "a list of modules exposed to users"++            sourceDirs <- get obj "source-directories" "the directories that hold source code"++            deps <- getDependencies obj++            natives <- maybe False id <$> obj .:? "native-modules"++            return $ Description name repo version summary license sourceDirs exposed natives deps++    parseJSON _ = mzero++++get :: FromJSON a => Object -> T.Text -> String -> Parser a+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:" +++                           "    <https://github.com/evancz/elm-html/blob/master/elm_dependencies.json>"+++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+++repoToName :: String -> Either String N.Name+repoToName repo =+    if not (end `List.isSuffixOf` repo)+        then Left msg+        else+            do  path <- getPath+                let raw = take (length path - length end) path+                case N.fromString raw of+                  Nothing   -> Left msg+                  Just name -> Right name+    where+      getPath+          | http  `List.isPrefixOf` repo = Right $ drop (length http ) repo+          | https `List.isPrefixOf` repo = Right $ drop (length https) repo+          | otherwise = Left msg++      http  = "http://github.com/"+      https = "https://github.com/"+      end = ".git"+      msg =+          "the 'repository' field must point to a GitHub project for now, something\n\+          \like <https://github.com/USER/PROJECT.git> where USER is your GitHub name\n\+          \and PROJECT is the repo you want to upload."
+ src/Elm/Package/Initialize.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE FlexibleContexts #-}+module Elm.Package.Initialize (solution) where++import Control.Monad.Error (MonadError, MonadIO, liftIO, throwError)+import qualified Data.Map as Map+import System.Directory (doesFileExist)++import qualified Elm.Package.Paths as Path+import qualified Elm.Package.Solution as S+import qualified Install+import qualified Manager+++solution :: (MonadError String m, MonadIO m) => Bool -> m S.Solution+solution autoYes =+    runInstall autoYes Install.Everything+++runInstall+    :: (MonadError String m, MonadIO m)+    => Bool+    -> Install.Args+    -> m S.Solution+runInstall autoYes args =+  do  either <- liftIO $ do+          env <- Manager.defaultEnvironment+          Manager.run env (Install.install autoYes args)++      case either of+        Left err -> throwError err+        Right () ->+          do  exists <- liftIO (doesFileExist Path.solvedDependencies)+              if exists+                  then S.read Path.solvedDependencies+                  else return Map.empty
+ src/Elm/Package/Name.hs view
@@ -0,0 +1,77 @@+module Elm.Package.Name where++import Control.Applicative ((<$>), (<*>))+import Control.Monad.Error+import Data.Aeson+import Data.Binary+import qualified Data.Text as T+import qualified Data.Maybe as Maybe+import System.FilePath ((</>))+++data Name = Name+    { user :: String+    , project :: String+    }+    deriving (Eq, Ord)+++dummyName :: Name+dummyName =+    Name "USER" "PROJECT"+++toString :: Name -> String+toString name =+    user name ++ "/" ++ project name+++toUrl :: Name -> String+toUrl name =+    user name ++ "/" ++ project name+++toFilePath :: Name -> FilePath+toFilePath name =+    user name </> project name+++fromString :: String -> Maybe Name+fromString string =+    case break (=='/') string of+      ( user@(_:_), '/' : project@(_:_) )+          | all (/='/') project -> Just (Name user project)+      _ -> Nothing+++fromString' :: String -> ErrorT String IO Name+fromString' string =+    Maybe.maybe (throwError $ errorMsg string) return (fromString string)+++instance Binary Name where+    get = Name <$> get <*> get+    put (Name user project) =+        do  put user+            put project+++instance FromJSON Name where+    parseJSON (String text) =+        let string = T.unpack text in+        Maybe.maybe (fail $ errorMsg string) return (fromString string)++    parseJSON _ = fail "Project name must be a string."+++instance ToJSON Name where+    toJSON name =+        toJSON (toString name)+++errorMsg :: String -> String+errorMsg string =+    unlines+    [ "Dependency file has an invalid name: " ++ string+    , "Must have format USER/PROJECT and match a public github project."+    ]
+ src/Elm/Package/Paths.hs view
@@ -0,0 +1,48 @@+{-# OPTIONS_GHC -Wall #-}+module Elm.Package.Paths where++import System.FilePath ((</>))+import qualified Elm.Package.Name as N+import qualified Elm.Package.Version as V+++{-| Name of directory for all of a project's dependencies. -}+stuffDirectory :: FilePath+stuffDirectory =+    "elm-stuff"+++{-| Describes the exact versions of every package used for your project. This+information is written by elm-package when it solves and installs dependencies.+-}+solvedDependencies :: FilePath+solvedDependencies =+    stuffDirectory </> "exact-dependencies.json"+++{-| Documentation for all the exposed modules in this package.+-}+documentation :: FilePath+documentation =+    stuffDirectory </> "documentation.json"+++{-| Name of the dependency file, specifying dependencies and other metadata+for building and sharing projects.+-}+description :: FilePath+description =+    "elm-package.json"+++{-| Directory for all packages needed to build your project.+-}+packagesDirectory :: FilePath+packagesDirectory =+    stuffDirectory </> "packages"+++{-| Path to a particular package. -}+package :: N.Name -> V.Version -> FilePath+package name version =+    packagesDirectory </> N.toFilePath name </> V.toString version
+ src/Elm/Package/Solution.hs view
@@ -0,0 +1,65 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE FlexibleContexts #-}+module Elm.Package.Solution (Solution, write, read) where++import Prelude hiding (read)+import Control.Monad.Error (MonadError, throwError, MonadIO, liftIO)+import Data.Aeson+import Data.Aeson.Encode.Pretty (encodePretty)+import qualified Data.ByteString.Lazy as BS+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Map as Map+import qualified Data.Text as Text++import qualified Elm.Package.Name as N+import qualified Elm.Package.Version as V+++type Solution =+    Map.Map N.Name V.Version+++-- READING AND WRITING SOLUTIONS++write :: FilePath -> Solution -> IO ()+write filePath solution =+    BS.writeFile filePath (encodePretty (toJson solution))+++read :: (MonadIO m, MonadError String m) => FilePath -> m Solution+read path =+  do  rawJson <- liftIO (BS.readFile path)+      either throwCorrupted fromJson (eitherDecode rawJson)+  where+    throwCorrupted _msg =+        throwError $+            "Unable to extract package information from the " ++ path +++            " file.\nIt may be corrupted."+++-- CONVERSION TO JSON++toJson :: Solution -> Value+toJson solution =+    object (map toField (Map.toList solution))+  where+    toField (name, version) =+        Text.pack (N.toString name) .= Text.pack (V.toString version)+++fromJson :: (MonadError String m) => HashMap.HashMap String String -> m Solution+fromJson hashMap =+    do  pairs <- mapM parseNameAndVersion (HashMap.toList hashMap)+        return (Map.fromList pairs)+++parseNameAndVersion :: (MonadError String m) => (String,String) -> m (N.Name, V.Version)+parseNameAndVersion (rawName, rawVersion) =+    do  name <- parse rawName N.fromString ("package name " ++ rawName)+        vrsn <- parse rawVersion V.fromString ("version number for package " ++ rawName)+        return (name, vrsn)+++parse :: (MonadError String m) => String -> (String -> Maybe a) -> String -> m a+parse string fromString msg =+    maybe (throwError ("Could not parse " ++ msg)) return (fromString string)
+ src/Elm/Package/Version.hs view
@@ -0,0 +1,112 @@+module Elm.Package.Version where++import Control.Applicative ((<$>), (<*>))+import Data.Aeson+import Data.Binary+import Data.Char (isDigit)+import Data.Function (on)+import qualified Data.List as List+import qualified Data.Text as T++elmVersion :: Version+elmVersion = error "Package.Version.elmVersion"+++data Version = Version+    { major :: Int+    , minor :: Int+    , patch :: Int+    }+    deriving (Eq, Ord)+++initialVersion :: Version+initialVersion =+    Version 1 0 0++dummyVersion :: Version+dummyVersion =+    Version 0 0 0+++bumpPatch :: Version -> Version+bumpPatch (Version major minor patch) =+    Version major minor (patch + 1)++bumpMinor :: Version -> Version+bumpMinor (Version major minor _patch) =+    Version major (minor + 1) 0++bumpMajor :: Version -> Version+bumpMajor (Version major _minor _patch) =+    Version (major + 1) 0 0+++-- FILTERING++filterLatest :: (Ord a) => (Version -> a) -> [Version] -> [Version]+filterLatest characteristic versions =+    map last (List.groupBy ((==) `on` characteristic) (List.sort versions))+++majorAndMinor :: Version -> (Int,Int)+majorAndMinor (Version major minor _patch) =+    (major, minor)+++-- CONVERSIONS++toString :: Version -> String+toString (Version major minor patch) =+    show major ++ "." ++ show minor ++ "." ++ show patch+++fromString :: String -> Maybe Version+fromString string =+      case splitNumbers string of+        Just [major, minor, patch] ->+            Just (Version major minor patch)+        _ -> Nothing+    where+      splitNumbers :: String -> Maybe [Int]+      splitNumbers ns =+          case span isDigit ns of+            ("", _) ->+                Nothing++            (numbers, []) ->+                Just [ read numbers ]++            (numbers, '.':rest) ->+                (read numbers :) <$> splitNumbers rest++            _ -> Nothing+++instance Binary Version where+    get = Version <$> get <*> get <*> get+    put (Version major minor patch) =+        do put major+           put minor+           put patch+++instance FromJSON Version where+    parseJSON (String text) =+        let string = T.unpack text in+        case fromString string of+          Just v -> return v+          Nothing ->+              fail $ unlines+                 [ "Dependency file has an invalid version number: " ++ string+                 , "Must have format MAJOR.MINOR.PATCH (e.g. 0.1.2)"+                 ]++    parseJSON _ =+        fail "Version number must be stored as a string."+++instance ToJSON Version where+    toJSON version =+        toJSON (toString version)+
+ src/GitHub.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+module GitHub (getVersionTags) where++import Control.Monad.Error+import Data.Aeson as Json+import qualified Data.Maybe as Maybe+import Data.Monoid ((<>))+import qualified Data.Vector as Vector+import Network.HTTP.Client++import qualified Elm.Package.Name as Name+import qualified Elm.Package.Version as Version+import qualified Utils.Http as Http+++-- TAGS from GITHUB++newtype Tags = Tags [String]+++getVersionTags+    :: (MonadIO m, MonadError String m)+    => Name.Name -> m [Version.Version]++getVersionTags (Name.Name user project) =+  do  response <-+          Http.send url $ \request manager ->+              httpLbs (request {requestHeaders = headers}) manager+      case Json.eitherDecode (responseBody response) of+        Left err -> throwError err+        Right (Tags tags) -> return (Maybe.mapMaybe Version.fromString tags)++  where+    url = "https://api.github.com/repos/" ++ user ++ "/" ++ project ++ "/tags"++    headers =+        [("User-Agent", "elm-package")]+        <> [("Accept", "application/json")]+++instance FromJSON Tags where+    parseJSON (Array arr) =+        Tags `fmap` mapM toTag (Vector.toList arr)+      where+        toTag (Object obj) = obj .: "name"+        toTag _ = fail "expecting an object"++    parseJSON _ = fail "expecting an array"+
+ src/Install.hs view
@@ -0,0 +1,205 @@+module Install where++import Control.Monad.Error+import qualified Data.List as List+import qualified Data.Map as Map+import System.Directory (doesFileExist, removeDirectoryRecursive)+import System.FilePath ((</>))++import qualified CommandLine.Helpers as Cmd+import qualified Elm.Package.Constraint as Constraint+import qualified Elm.Package.Description as Desc+import qualified Elm.Package.Name as N+import qualified Elm.Package.Paths as Path+import qualified Elm.Package.Solution as Solution+import qualified Elm.Package.Version as V+import qualified Install.Fetch as Fetch+import qualified Install.Plan as Plan+import qualified Install.Solver as Solver+import qualified Manager+import qualified Store+++data Args+    = Everything+    | Latest N.Name+    | Exactly N.Name V.Version+++install :: Bool -> Args -> Manager.Manager ()+install autoYes args =+  do  exists <- liftIO (doesFileExist Path.description)++      description <-+          case exists of+            True -> Desc.read Path.description+            False -> initialDescription++      case args of+        Everything ->+            upgrade autoYes description++        Latest name ->+            do  version <- latestVersion name+                newDescription <- addConstraint autoYes name version description+                upgrade autoYes newDescription++        Exactly name version ->+            do  newDescription <- addConstraint autoYes name version description+                upgrade autoYes newDescription+++-- INSTALL EVERYTHING++upgrade :: Bool -> Desc.Description -> Manager.Manager ()+upgrade autoYes description =+  do  newSolution <- Solver.solve (Desc.dependencies description)++      exists <- liftIO (doesFileExist Path.solvedDependencies)+      oldSolution <-+          if exists+              then Solution.read Path.solvedDependencies+              else return Map.empty++      let plan = Plan.create oldSolution newSolution++      approve <- liftIO (getApproval autoYes plan)++      if approve+          then runPlan newSolution plan+          else liftIO $ putStrLn "Okay, I did not change anything!"            +++getApproval :: Bool -> Plan.Plan -> IO Bool+getApproval autoYes plan =+  case autoYes || Plan.isEmpty plan of+    True ->+      return True++    False ->+      do  putStrLn "Some new packages are needed. Here is the upgrade plan."+          putStrLn (Plan.display plan)+          putStr "Do you approve of this plan? (y/n) "+          Cmd.yesOrNo+++runPlan :: Solution.Solution -> Plan.Plan -> Manager.Manager ()+runPlan solution plan =+  do  let installs =+            Map.toList (Plan.installs plan)+            ++ Map.toList (Map.map snd (Plan.upgrades plan))++      let removals =+            Map.toList (Plan.removals plan)+            ++ Map.toList (Map.map fst (Plan.upgrades plan))++      -- fetch new dependencies+      Cmd.inDir Path.packagesDirectory $+          forM_ installs $ \(name, version) ->+              do  liftIO (putStrLn ("Downloading " ++ N.toString name))+                  Fetch.package name version++      -- try to build new dependencies+      liftIO (Solution.write Path.solvedDependencies solution)++      -- remove dependencies that are not needed+      Cmd.inDir Path.packagesDirectory $+          forM_ removals $ \(name, version) ->+              liftIO $ removeDirectoryRecursive (N.toFilePath name </> V.toString version)++      liftIO $ putStrLn "Packages configured successfully!"+++-- MODIFY DESCRIPTION++latestVersion :: N.Name -> Manager.Manager V.Version+latestVersion name =+  do  versionCache <- Store.readVersionCache+      case Map.lookup name versionCache of+        Just versions ->+            return $ maximum versions++        Nothing ->+            throwError $+            unlines+            [ "No versions of package '" ++ N.toString name ++ "' were found!"+            , "Is it spelled correctly?"+            ]+++addConstraint :: Bool -> N.Name -> V.Version -> Desc.Description -> Manager.Manager Desc.Description+addConstraint autoYes name version description =+  case List.lookup name (Desc.dependencies description) of+    Nothing ->+      addNewDependency autoYes name version description++    Just constraint+      | Constraint.isSatisfied constraint version ->+          return description++      | otherwise ->+          throwError $+            "This is a tricky update, you should modify " ++ Path.description ++ " yourself.\n"+            ++ "Package " ++ N.toString name ++ " is already listed as a dependency:\n\n    "+            ++ 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"+++addNewDependency :: Bool -> N.Name -> V.Version -> Desc.Description -> Manager.Manager Desc.Description+addNewDependency autoYes name version description =+  do  confirm <-+          case autoYes of+            True -> return True+            False ->+              do  answer <- liftIO confirmNewAddition+                  liftIO (putStrLn "")+                  return answer++      case confirm of+        False ->+          do  liftIO $ putStrLn noConfirmation+              return description+        True ->+          do  let newDescription = description { Desc.dependencies = newConstraints }+              liftIO $ Desc.write newDescription+              return newDescription+  where+    newConstraint =+        Constraint.minimalRangeFrom version++    newConstraints =+        (name, newConstraint) : Desc.dependencies description++    noConfirmation =+        "Cannot install the new package unless it appears in " ++ Path.description ++ ".\n" +++        "If you do not like the constraint I suggested, change it manually and then run:\n" +++        "\n    elm-package install\n\n" +++        "This will install everything listed in " ++ Path.description ++ "."++    confirmNewAddition =+      do  putStrLn $+            "To install " ++ N.toString name ++ " I would like to add the following\n"+            ++ "dependency to " ++ Path.description ++ ":\n\n    "+            ++ showDependency name newConstraint+            ++ "\n"++          putStr $ "May I add that to " ++ Path.description ++ " for you? (y/n) "+          Cmd.yesOrNo+++showDependency :: N.Name -> Constraint.Constraint -> String+showDependency name constraint =+    show (N.toString name) ++ ": " ++ show (Constraint.toString constraint)+++initialDescription :: Manager.Manager Desc.Description+initialDescription =+  do  let core = N.Name "elm-lang" "core"+      version <- latestVersion core+      let desc = Desc.defaultDescription {+          Desc.dependencies = [ (core, Constraint.minimalRangeFrom version) ]+      }+      liftIO (Desc.write desc)+      return desc
+ src/Install/Fetch.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleContexts #-}+module Install.Fetch where++import Control.Monad.Error (MonadError, MonadIO, liftIO, throwError)+import qualified Codec.Archive.Zip as Zip+import qualified Data.List as List+import qualified Network.HTTP.Client as Client+import System.Directory (doesDirectoryExist, getDirectoryContents, renameDirectory)+import System.FilePath ((</>))++import qualified Elm.Package.Name as N+import qualified Elm.Package.Version as V+import qualified CommandLine.Helpers as Cmd+import qualified Utils.Http as Http+++package :: (MonadIO m, MonadError String m) => N.Name -> V.Version -> m ()+package name@(N.Name user _) version =+  ifNotExists name version $ do+      Http.send zipball extract+      files <- liftIO $ getDirectoryContents "."+      case List.find (List.isPrefixOf user) files of+        Nothing ->+            throwError "Could not download source code successfully."+        Just dir ->+            liftIO $ renameDirectory dir (V.toString version)+  where+    zipball =+        "http://github.com/" ++ N.toUrl name ++ "/zipball/" ++ V.toString version ++ "/"+++ifNotExists :: (MonadIO m, MonadError String m) => N.Name -> V.Version -> m () -> m ()+ifNotExists name version command =+  do  let directory = N.toFilePath name+      exists <- liftIO $ doesDirectoryExist (directory </> V.toString version)+      if exists+        then return ()+        else Cmd.inDir directory command+++extract :: Client.Request -> Client.Manager -> IO ()+extract request manager =+    do  response <- Client.httpLbs request manager+        let archive = Zip.toArchive (Client.responseBody response)+        Zip.extractFilesFromArchive [] archive
+ src/Install/Plan.hs view
@@ -0,0 +1,63 @@+module Install.Plan where++import qualified Data.Map as Map++import qualified Elm.Package.Solution as S+import qualified Elm.Package.Name as N+import qualified Elm.Package.Version as V+++data Plan = Plan+    { installs :: Map.Map N.Name V.Version+    , upgrades :: Map.Map N.Name (V.Version, V.Version)+    , removals :: Map.Map N.Name V.Version+    }+++create :: S.Solution -> S.Solution -> Plan+create old new =+    Plan+    { installs = Map.difference new old+    , upgrades = discardNoOps (Map.intersectionWith (,) old new)+    , removals = Map.difference old new+    }+  where+    discardNoOps updates =+      Map.mapMaybe isChanged updates++    isChanged upgrade@(oldVersion,newVersion) =+      if oldVersion == newVersion+        then Nothing+        else Just upgrade+++isEmpty :: Plan -> Bool+isEmpty (Plan installs upgrades removals) =+    Map.null installs+        && Map.null upgrades+        && Map.null removals+++-- DISPLAY++display :: Plan -> String+display (Plan installs upgrades removals) =+    "\n"+    ++ displayCategory "Install" displayInstall installs+    ++ displayCategory "Upgrade" displayUpgrade upgrades+    ++ displayCategory "Remove" displayRemove removals+  where+    displayCategory name render category =+        if Map.null category then "" else+          "  " ++ name ++ ":"+          ++ concatMap (\entry -> "\n    " ++ render entry) (Map.toList category)+          ++ "\n"++    displayInstall (name, version) =+        N.toString name ++ " " ++ V.toString version++    displayUpgrade (name, (old, new)) =+        N.toString name ++ " (" ++ V.toString old ++ " => " ++ V.toString new ++ ")"++    displayRemove (name, _version) =+        N.toString name
+ src/Install/Solver.hs view
@@ -0,0 +1,101 @@+module Install.Solver where++import Control.Monad.Error (throwError)+import Control.Monad.State (StateT, evalStateT)+import qualified Data.List as List+import qualified Data.Map as Map++import qualified Elm.Package.Constraint as C+import qualified Elm.Package.Name as N+import qualified Elm.Package.Solution as S+import qualified Elm.Package.Version as V+import qualified Manager+import qualified Store+++solve :: [(N.Name, C.Constraint)] -> Manager.Manager S.Solution+solve constraints =+    do  store <- Store.initialStore+        maybeSolution <- evalStateT (exploreConstraints constraints) store+        case maybeSolution of+          Just solution -> return solution+          Nothing ->+              throwError $+              "Unable to find a set of packages that will work with your constraints."+++-- EXPLORE CONSTRAINTS++type Explorer a =+    StateT Store.Store Manager.Manager a+++type Packages =+    Map.Map N.Name [V.Version]+++exploreConstraints :: [(N.Name, C.Constraint)] -> Explorer (Maybe S.Solution)+exploreConstraints constraints =+  do  maybeInitialPackages <- addConstraints Map.empty constraints+      let initialPackages = maybe Map.empty id maybeInitialPackages+      explorePackages Map.empty initialPackages+++explorePackages :: S.Solution -> Packages -> Explorer (Maybe S.Solution)+explorePackages solution availablePackages =+    case Map.minViewWithKey availablePackages of+      Nothing ->+          return (Just solution)++      Just ((name, versions), remainingPackages) ->+          exploreVersionList name versions solution remainingPackages+++exploreVersionList :: N.Name -> [V.Version] -> S.Solution -> Packages -> Explorer (Maybe S.Solution)+exploreVersionList name versions solution remainingPackages =+    go (reverse (V.filterLatest V.majorAndMinor versions))+  where+    go versions =+        case versions of+          [] -> return Nothing+          version : rest ->+              do  maybeSolution <- exploreVersion name version solution remainingPackages+                  case maybeSolution of+                    Nothing -> go rest+                    answer -> return answer+++exploreVersion :: N.Name -> V.Version -> S.Solution -> Packages -> Explorer (Maybe S.Solution)+exploreVersion name version solution remainingPackages =+  do  constraints <- Store.getConstraints name version++      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+++satisfiedBy :: S.Solution -> (N.Name, C.Constraint) -> Bool+satisfiedBy solution (name, constraint) =+    case Map.lookup name solution of+      Nothing -> False+      Just version ->+          C.isSatisfied constraint version+++addConstraints :: Packages -> [(N.Name, C.Constraint)] -> Explorer (Maybe Packages)+addConstraints packages constraints =+    case constraints of+      [] -> return (Just packages)+      (name, constraint) : rest ->+          do  versions <- Store.getVersions name+              case filter (C.isSatisfied constraint) versions of+                [] -> return Nothing+                vs -> addConstraints (Map.insert name vs packages) rest
+ src/Main.hs view
@@ -0,0 +1,44 @@+module Main where++import System.Directory (findExecutable)+import System.Exit (exitFailure)+import System.IO++import qualified CommandLine.Arguments as Arguments+import qualified Manager+++main :: IO ()+main =+  do  requireGit+      manager <- Arguments.parse+      env <- Manager.defaultEnvironment+      result <- Manager.run env manager+      case result of+        Right () ->+            return ()++        Left err ->+            errExit ("\nError: " ++ err ++ newline)+          where+            newline = if last err == '\n' then "" else "\n"+++errExit :: String -> IO ()+errExit msg =+  do  hPutStrLn stderr msg+      exitFailure+++requireGit :: IO ()+requireGit =+  do  maybePath <- findExecutable "git"+      case maybePath of+        Just _  -> return ()+        Nothing -> errExit gitNotInstalledMessage+  where+    gitNotInstalledMessage =+        "\n\+        \The REPL relies on git to download libraries and manage versions.\n\+        \    It appears that you do not have git installed though!\n\+        \    Get it from <http://git-scm.com/downloads> to continue."
+ src/Manager.hs view
@@ -0,0 +1,35 @@+module Manager where++import Control.Monad.Error+import Control.Monad.Reader+import qualified System.Directory as Dir+import System.FilePath ((</>))+++type Manager =+    ErrorT String (ReaderT Environment IO)+++run :: Environment -> Manager a -> IO (Either String a)+run environment manager =+    runReaderT (runErrorT manager) environment+++data Environment = Environment+    { catalog :: String+    , cacheDirectory :: FilePath+    }+++defaultEnvironment :: IO Environment+defaultEnvironment =+    do  cacheDirectory <- getCacheDirectory+        return (Environment "http://package.elm-lang.org" cacheDirectory)+++getCacheDirectory :: IO FilePath+getCacheDirectory =+    do  root <- Dir.getAppUserDataDirectory "elm"+        let dir = root </> "package"+        Dir.createDirectoryIfMissing True dir+        return dir
+ src/Publish.hs view
@@ -0,0 +1,102 @@+module Publish where++import Control.Monad.Error (throwError)+import qualified Data.Maybe as Maybe++import qualified Bump+import qualified Catalog+import qualified CommandLine.Helpers as Cmd+import qualified Docs+import qualified Elm.Docs as Docs+import qualified Elm.Package.Description as Desc+import qualified Elm.Package.Name as N+import qualified Elm.Package.Paths as P+import qualified Elm.Package.Version as V+import qualified GitHub+import qualified Manager+++publish :: Manager.Manager ()+publish =+  do  description <- Desc.read P.description++      let name = Desc.name description+      let version = Desc.version description++      Cmd.out $ unwords [ "Verifying", N.toString name, V.toString version, "..." ]+      verifyMetadata description++      docs <- Docs.generate description++      validity <- verifyVersion docs description+      newVersion <-+          case validity of+            Bump.Valid -> return version+            Bump.Invalid -> throwError "Cannot publish with an invalid version!"+            Bump.Changed v -> return v++      verifyTag name newVersion+      Catalog.register name newVersion+      Cmd.out "Success!"++++verifyMetadata :: Desc.Description -> Manager.Manager ()+verifyMetadata deps =+    case problems of+      [] -> return ()+      _  ->+          throwError $+          "Some of the fields in " ++ P.description +++          " have not been filled in yet:\n\n" ++ unlines problems +++          "\nFill these in and try to publish again!"+    where+      problems = Maybe.catMaybes+          [ verify Desc.repo        "  repository - must refer to a valid repo on GitHub"+          , verify Desc.summary     "  summary - a quick summary of your project, 80 characters or less"+          , verify Desc.exposed     "  exposed-modules - list modules your project exposes to users"+          ]++      verify getField msg =+          if getField deps == getField Desc.defaultDescription+            then Just msg+            else Nothing+++verifyVersion+    :: [Docs.Documentation]+    -> Desc.Description+    -> Manager.Manager Bump.Validity+verifyVersion docs description =+  let name = Desc.name description+      version = Desc.version description+  in+  do  maybeVersions <- Catalog.versions name+      case maybeVersions of+        Just publishedVersions ->+            Bump.validateVersion docs name version publishedVersions++        Nothing ->+            Bump.validateInitialVersion description+++verifyTag :: N.Name -> V.Version -> Manager.Manager ()+verifyTag name version =+    do  publicVersions <- GitHub.getVersionTags name+        if version `elem` publicVersions+            then return ()+            else throwError (tagMessage version)+++tagMessage :: V.Version -> String+tagMessage version =+    let v = V.toString version in+    unlines+    [ "Libraries must be tagged in git, but tag " ++ v ++ " was not found."+    , "These tags make it possible to find this specific version on github."+    , "To tag the most recent commit and push it to github, run this:"+    , ""+    , "    git tag -a " ++ v ++ " -m \"release version " ++ v ++ "\""+    , "    git push origin " ++ v+    , ""+    ]
+ src/Store.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE FlexibleContexts #-}+module Store (Store, getConstraints, getVersions, initialStore, readVersionCache) where++import Control.Monad.Error (MonadError, throwError)+import Control.Monad.RWS (MonadIO, liftIO, MonadReader, asks, MonadState, gets, modify)+import qualified Data.Binary as Binary+import qualified Data.ByteString.Lazy as BS+import qualified Data.Map as Map+import qualified Data.Time.Clock as Time+import qualified System.Directory as Dir+import System.FilePath ((</>))++import qualified Catalog+import qualified Elm.Package.Constraint as C+import qualified Elm.Package.Description as Desc+import qualified Elm.Package.Name as N+import qualified Elm.Package.Version as V+import qualified Manager+++-- STORE++data Store = Store+    { constraintCache :: ConstraintCache+    , versionCache :: VersionCache+    }++type ConstraintCache =+    Map.Map (N.Name, V.Version) [(N.Name, C.Constraint)]++type VersionCache =+    Map.Map N.Name [V.Version]+++initialStore+    :: (MonadIO m, MonadReader Manager.Environment m, MonadError String m)+    => m Store++initialStore =+  do  versionCache <- readVersionCache+      return (Store Map.empty versionCache)+++readVersionCache+    :: (MonadIO m, MonadReader Manager.Environment m, MonadError String m)+    => m VersionCache++readVersionCache =+  do  cacheDirectory <- asks Manager.cacheDirectory+      let versionsFile = cacheDirectory </> "versions.json"+      let lastUpdatedPath = cacheDirectory </> "last-updated"++      now <- liftIO Time.getCurrentTime++      exists <- liftIO (Dir.doesFileExist lastUpdatedPath)+      maybeTime <-+          case exists of+            False -> return Nothing+            True ->+              do  rawTime <- liftIO (readFile lastUpdatedPath)+                  return $ Just (read rawTime)++      maybePackages <- Catalog.allPackages maybeTime++      case maybePackages of+        Nothing ->+          do  exists <- liftIO (Dir.doesFileExist versionsFile)+              case exists of+                False -> return Map.empty+                True ->+                  do  binary <- liftIO (BS.readFile versionsFile)+                      return (Binary.decode binary)++        Just packages ->+          let cache :: VersionCache+              cache = Map.fromList packages+          in+              do  liftIO $ BS.writeFile versionsFile (Binary.encode cache)+                  liftIO $ writeFile lastUpdatedPath (show now)+                  return cache+++-- CONSTRAINTS++getConstraints+    :: (MonadIO m, MonadReader Manager.Environment m, MonadState Store m, MonadError String m)+    => N.Name+    -> V.Version+    -> m [(N.Name, C.Constraint)]++getConstraints name version =+  do  cache <- gets constraintCache+      case Map.lookup (name, version) cache of+        Just constraints -> return constraints+        Nothing ->+          do  desc <- Catalog.description name version+              let constraints = Desc.dependencies desc+              modify $ \store ->+                  store {+                      constraintCache =+                          Map.insert (name, version) constraints (constraintCache store)+                  }+              return constraints+++-- VERSIONS++getVersions :: (MonadIO m, MonadError String m, MonadState Store m) => N.Name -> m [V.Version]+getVersions name =+  do  cache <- gets versionCache+      case Map.lookup name cache of+        Just versions -> return versions+        Nothing ->+            throwError noLocalVersions+  where+    noLocalVersions =+        "There are no versions of package '" ++ N.toString name ++ "' on your computer."
+ src/Utils/Http.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+module Utils.Http (send) where++import qualified Control.Exception as E+import Control.Monad.Error+import qualified Data.ByteString.Char8 as BSC+import qualified Data.List as List+import Network (withSocketsDo)+import Network.HTTP.Client+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.HTTP.Types+++send+    :: (MonadIO m, MonadError String m)+    => String+    -> (Request -> Manager -> IO a)+    -> m a+send url handler =+  do  result <- liftIO (sendSafe url handler)+      either throwError return result+++sendSafe :: String -> (Request -> Manager -> IO a) -> IO (Either String a)+sendSafe url handler =+    sendUnsafe url handler+      `E.catch` handleHttpError url+      `E.catch` (handleAnyError url :: E.SomeException -> IO (Either String b))++++sendUnsafe :: String -> (Request -> Manager -> IO a) -> IO (Either err a)+sendUnsafe url handler =+  do  request <- parseUrl url+      result <- withSocketsDo $ withManager tlsManagerSettings (handler request)+      return (Right result)+++handleHttpError :: String -> HttpException -> IO (Either String b)+handleHttpError url exception =+  case exception of+    StatusCodeException (Status _code err) headers _ ->+        let details =+              case List.lookup "X-Response-Body-Start" headers of+                Just msg | not (BSC.null msg) -> msg+                _ -> err+        in+            return . Left $ BSC.unpack details++    _ -> handleAnyError url exception+++handleAnyError :: (E.Exception e) => String -> e -> IO (Either String b)+handleAnyError url exception =+  return . Left $+      "failed with '" ++ show exception ++ "' when sending request to\n" +++      "    <" ++ url ++ ">"
+ src/Utils/Paths.hs view
@@ -0,0 +1,21 @@+module Utils.Paths where++import System.FilePath++import qualified Elm.Package.Name as N+import qualified Elm.Package.Version as Version++internals = "_internals"++libDir = "public" </> "catalog"++json = "docs.json"+index = "index.elm"+listing = "public" </> "libraries.json"++library name = libDir </> N.toFilePath name++libraryVersion :: N.Name -> Version.Version -> FilePath+libraryVersion name version =+	library name </> Version.toString version+
+ tests/SolverTests.hs view
@@ -0,0 +1,151 @@+module SolverTests (solverTests) where++import Control.Monad.Identity+import Control.Monad.Error+import Control.Monad.Reader+import Control.Monad.State+import Test.HUnit ((@?), Assertion)+import qualified Test.Framework as TF+import qualified Test.Framework.Providers.HUnit as TH+import qualified Utils.ResolveDeps as Deps+import Data.Map (Map)+import qualified Data.Map as Map+import qualified Elm.Internal.Constraint as C+import qualified Elm.Internal.Version as V+import qualified Elm.Internal.Name as N+++-- SETUP++type FakeDB = Map N.Name [(V.Version, Deps.Constraints)]++db1 :: FakeDB+db1 = Map.fromList [ base, transformers, mtl, conduit, http ]+  where+    base =+      (n "base", [ (v "0.1", []), (v "0.2", []), (v "1.0", []), (v "1.1", []) ])++    transformers =+      (n "transformers", [ (v "1.0", [(n "base", c ">=1.0 <2.0")]) ])++    mtl =+      (n "mtl", [ (v "1.0", [ (n "base", c ">=0.2 <1.0") ])+                , (v "2.0", [ (n "base", c ">=0.2 <2.0")+                            , (n "transformers", c ">=1.0 <2.0")+                            ])+                ])++    conduit =+      (n "conduit", [ (v "1.0", [ (n "base", c ">=1.0 <1.1")+                                , (n "http", c ">=2.0 <3.0")+                                ])+                    ])++    http =+      (n "http", [ (v "2.1", [ (n "base", c ">=1.1 <2.0") ]) ])++expectSolution :: FakeDB -> N.Name -> V.Version -> Assertion+expectSolution db name version =+  do solution <- fromError $ solveFake db name version+     isValidSolution db solution @? "Solution should pass sanity check"++expectNoSolution :: FakeDB -> N.Name -> V.Version -> Assertion+expectNoSolution db name version =+  let solution = runIdentity $ runErrorT $ solveFake db name version+  in case solution of+       Left err -> return ()+       Right sol ->+         do when (isValidSolution db sol) $ putStrLn "FAULTY TESTS: solution is valid!"+            False @? ("Unexpected solution " ++ show sol)++test1 = expectSolution db1 (n "mtl") (v "1.0")+test2 = expectSolution db1 (n "mtl") (v "2.0")+test3 = expectNoSolution db1 (n "conduit") (v "1.0")++solverTests =+  TF.testGroup "Dependency solver tests"+  [ TH.testCase "test1" test1+  , TH.testCase "test2" test2+  , TH.testCase "test3" test3+  ]+++fromError :: ErrorT String Identity a -> IO a+fromError action =+  either fail return $ runIdentity (runErrorT action)++-- CHECK FOR VALIDITY OF SOLUTIONS++{-| Check whether given solution is really a solution. Supposed to use as+a sanity check for existing tests and solver solutions+-}+isValidSolution :: FakeDB -> [(N.Name, V.Version)] -> Bool+isValidSolution db solution =+    all isConsistent solution+  where+    isConsistent (name, version) =+      maybe False id $ do+        versions <- Map.lookup name db+        constraints <- lookup version versions+        return (all isSatisfied constraints)++    isSatisfied (name, constraint) =+      maybe False id $ do+        version <- lookup name solution+        return (C.satisfyConstraint constraint version)+++-- RUN SOLVER++-- | Run dependency solver using stub data+solveFake :: FakeDB -> N.Name -> V.Version -> ErrorT String Identity [(N.Name, V.Version)]+solveFake db name version =+  do let libraryDb = toLibraryDb db+         unreader = runReaderT (Deps.solveForVersion name version) $+                    Deps.SolverEnv libraryDb (readConstraints db)+         initialState = Deps.SolverState Map.empty+     (solved, _) <- runStateT unreader initialState+     return $ Map.toList solved++-- | A function passed to solver which "reads" constraints by name and version+readConstraints :: FakeDB -> N.Name -> V.Version -> ErrorT String Identity Deps.Constraints+readConstraints db name version =+    maybe notFound return $ do+      versions <- Map.lookup name db+      lookup version versions+  where+    notFound =+      throwError $ "Could not find " ++ N.toString name ++ " " ++ V.toString version++{-| Extract from stub data list of libraries and their version in+format solver expects+-}+toLibraryDb :: FakeDB -> Deps.LibraryDB+toLibraryDb fakeDb =+    Map.fromList (map toLibraryEntry (Map.toList fakeDb))+  where+    toLibraryEntry (name, details) =+      ( N.toString name+      , Deps.LibraryInfo (N.toString name) "" (map fst details)+      )+++-- SETUP HELPERS+-- make it easier to create a FakeDb++v :: String -> V.Version+v = unsafeUnpackJust "version" . V.fromString++c :: String -> C.Constraint+c = unsafeUnpackJust "constraint" . C.fromString++n :: String -> N.Name+n = unsafeUnpackJust "name" . N.fromString . ("a/" ++)++unsafeUnpackJust :: String -> Maybe a -> a+unsafeUnpackJust msg result =+  case result of+    Just v -> v+    Nothing -> error $ "error unpacking " ++ msg ++ " from string"++
+ tests/Tests.hs view
@@ -0,0 +1,8 @@+module Main where++import qualified Test.Framework as TF++import SolverTests+import ComparisonTests++main = TF.defaultMain [ solverTests, comparisonTests ]