Finish up all major publish code

There's still some bug now where I can't pull down all-packages for some
HTTPS reason

builder/src/Deps/Registry.hs

@@ -184,7 +184,15 @@ fetchSingleCustomRepository manager customRepositoryData =
         repositoryUrl = _pzrPackageServerRepoTypeUrl pzrPackageServerRepo
         repositoryAuthToken = _pzrPackageServerRepoAuthToken pzrPackageServerRepo
       in
-      undefined
+      fetchFromRepositoryUrlWithRepoAuthToken manager repositoryUrl repositoryAuthToken
+
+
+fetchFromRepositoryUrlWithRepoAuthToken :: Http.Manager -> RepositoryUrl -> RepositoryAuthToken -> IO (Either Exit.RegistryProblem Registry)
+fetchFromRepositoryUrlWithRepoAuthToken manager repositoryUrl repositoryAuthToken =
+  getWithHeaders manager repositoryUrl "/all-packages" [createAuthHeader repositoryAuthToken] allPkgsDecoder $
+    \versions ->
+      do  let size = Map.foldr' addEntry 0 versions
+          pure $ Registry size versions
 
 
 fetchFromRepositoryUrl :: Http.Manager -> RepositoryUrl -> IO (Either Exit.RegistryProblem Registry)
@@ -281,7 +289,7 @@ updateSingleRegistryFromPZRRepo manager pzrPackageServerRepo oldRegistry@(Regist
     serverUrl = _pzrPackageServerRepoTypeUrl pzrPackageServerRepo
     repoAuthToken = _pzrPackageServerRepoAuthToken pzrPackageServerRepo
   in
-  postWithHeaders manager serverUrl ("/all-packages/since/" ++ show size) [createAuthHeader repoAuthToken] (D.list newPkgDecoder) $
+  getWithHeaders manager serverUrl ("/all-packages/since/" ++ show size) [createAuthHeader repoAuthToken] (D.list newPkgDecoder) $
     \news ->
       case news of
         [] ->
@@ -392,22 +400,39 @@ getVersions' name zokkaRegistry =
 
 -- POST
 
+-- FIXME: It's really unclear whether we should have post stuff here, since technically everything should be doable with a GET?
 postWithHeaders :: Http.Manager -> RepositoryUrl -> String -> [Header] -> D.Decoder x a -> (a -> IO b) -> IO (Either Exit.RegistryProblem b)
 postWithHeaders manager repositoryUrl path headers decoder callback =
   let
     url = Website.route repositoryUrl path []
   in
-  Http.post manager url headers Exit.RP_Http $
-    \body ->
-      case D.fromByteString decoder body of
-        Right a -> Right <$> callback a
-        Left _ -> return $ Left $ Exit.RP_Data url body
+  do
+    print "Hello there!"
+    Http.post manager url headers Exit.RP_Http $
+      \body ->
+        case D.fromByteString decoder body of
+          Right a -> Right <$> callback a
+          Left _ -> return $ Left $ Exit.RP_Data url body
 
 post :: Http.Manager -> RepositoryUrl -> String -> D.Decoder x a -> (a -> IO b) -> IO (Either Exit.RegistryProblem b)
 post manager repositoryUrl path decoder callback =
   postWithHeaders manager repositoryUrl path [] decoder callback
 
 
+-- GET
+
+-- FIXME: This maybe should just replace all the POSTs?
+getWithHeaders :: Http.Manager -> RepositoryUrl -> String -> [Header] -> D.Decoder x a -> (a -> IO b) -> IO (Either Exit.RegistryProblem b)
+getWithHeaders manager repositoryUrl path headers decoder callback =
+  let
+    url = Website.route repositoryUrl path []
+  in
+  Http.get manager url headers Exit.RP_Http $
+    \body ->
+      case D.fromByteString decoder body of
+        Right a -> Right <$> callback a
+        Left _ -> return $ Left $ Exit.RP_Data url body
+
 
 -- BINARY
 

builder/src/Elm/CustomRepositoryData.hs

@@ -10,6 +10,7 @@ module Elm.CustomRepositoryData
   , RepositoryType(..)
   , RepositoryUrl
   , RepositoryAuthToken
+  , RepositoryLocalName
   , PackageUrl
   , SinglePackageFileType(..)
   , customRepostoriesDataDecoder
@@ -40,6 +41,8 @@ import Control.Monad (when)
 
 data REPOSITORYURL
 data PACKAGEURL
+data REPOSITORYAUTHTOKEN
+data REPOSITORYLOCALNAME
 
 data RepositoryType
   = DefaultPackageServer
@@ -49,11 +52,10 @@ data RepositoryType
 
 data DefaultPackageServerRepo = DefaultPackageServerRepo
   { _defaultPackageServerRepoTypeUrl :: !RepositoryUrl
+  , _defaultPackageServerRepoLocalName :: !RepositoryLocalName
   }
     deriving (Show, Ord, Eq)
 
-data REPOSITORYAUTHTOKEN
-
 type RepositoryAuthToken = Utf8.Utf8 REPOSITORYAUTHTOKEN
 
 instance Binary.Binary (Utf8.Utf8 REPOSITORYAUTHTOKEN) where
@@ -64,6 +66,7 @@ instance Binary.Binary (Utf8.Utf8 REPOSITORYAUTHTOKEN) where
 data PZRPackageServerRepo = PZRPackageServerRepo
   { _pzrPackageServerRepoTypeUrl :: !RepositoryUrl
   , _pzrPackageServerRepoAuthToken :: !RepositoryAuthToken
+  , _pzrPackageServerRepoLocalName :: !RepositoryLocalName
   }
     deriving (Show, Ord, Eq)
 
@@ -109,6 +112,21 @@ repositoryTypeEncoder :: RepositoryType -> E.Value
 repositoryTypeEncoder DefaultPackageServer = E.string defaultPackageServerString
 repositoryTypeEncoder PZRPackageServer = E.string pzrPackageServerString
 
+type RepositoryLocalName = Utf8.Utf8 REPOSITORYLOCALNAME
+
+instance Binary.Binary (Utf8.Utf8 REPOSITORYLOCALNAME) where
+  get = Utf8.getVeryLong
+  put = Utf8.putVeryLong
+
+
+repositoryLocalNameDecoder :: D.Decoder e RepositoryLocalName
+repositoryLocalNameDecoder = fmap coerce D.string
+
+
+repositoryLocalNameEncoder :: RepositoryLocalName -> E.Value
+repositoryLocalNameEncoder repositoryLocalName = E.string (coerce repositoryLocalName)
+
+
 type RepositoryUrl = Utf8.Utf8 REPOSITORYURL
 
 instance Binary.Binary (Utf8.Utf8 REPOSITORYURL) where
@@ -154,6 +172,7 @@ data CustomSingleRepositoryData
 standardElmRepositoryDefaultPackageServerRepo :: DefaultPackageServerRepo
 standardElmRepositoryDefaultPackageServerRepo = DefaultPackageServerRepo
   { _defaultPackageServerRepoTypeUrl = Utf8.fromChars "https://package.elm-lang.org"
+  , _defaultPackageServerRepoLocalName = Utf8.fromChars "standard-elm-repository"
   }
 
 standardElmRepository :: CustomSingleRepositoryData
@@ -162,6 +181,7 @@ standardElmRepository = DefaultPackageServerRepoData standardElmRepositoryDefaul
 standardZokkaRepositoryDefaultPackageServerRepo :: DefaultPackageServerRepo
 standardZokkaRepositoryDefaultPackageServerRepo = DefaultPackageServerRepo
   { _defaultPackageServerRepoTypeUrl = Utf8.fromChars "https://package-server.zokka-lang.com"
+  , _defaultPackageServerRepoLocalName = Utf8.fromChars "standard-zokka-repository"
   }
 
 standardZokkaRepository :: CustomSingleRepositoryData
@@ -178,26 +198,29 @@ customSingleRepositoryDataDecoder =
   do
     repositoryType <- D.field "repository-type" (repositoryTypeDecoder UnsupportedRepositoryType)
     repositoryUrl <- D.field "repository-url" repositoryUrlDecoder
+    repositoryLocalName <- D.field "repository-local-name" repositoryLocalNameDecoder
     case repositoryType of
       DefaultPackageServer ->
-        pure (DefaultPackageServerRepoData (DefaultPackageServerRepo{_defaultPackageServerRepoTypeUrl=repositoryUrl}))
+        pure (DefaultPackageServerRepoData (DefaultPackageServerRepo{_defaultPackageServerRepoTypeUrl=repositoryUrl, _defaultPackageServerRepoLocalName=repositoryLocalName}))
       PZRPackageServer ->
         do
           repositoryAuthToken <- D.field "repository-auth-token" repositoryAuthTokenDecoder
-          pure (PZRPackageServerRepoData (PZRPackageServerRepo {_pzrPackageServerRepoAuthToken=repositoryAuthToken, _pzrPackageServerRepoTypeUrl=repositoryUrl}))
+          pure (PZRPackageServerRepoData (PZRPackageServerRepo {_pzrPackageServerRepoAuthToken=repositoryAuthToken, _pzrPackageServerRepoTypeUrl=repositoryUrl, _pzrPackageServerRepoLocalName=repositoryLocalName}))
 
 customSingleRepositoryDataEncoder :: CustomSingleRepositoryData -> E.Value
 customSingleRepositoryDataEncoder customSingleRepositoryData =
   case customSingleRepositoryData of
-    DefaultPackageServerRepoData defaultPackageServerRepoData ->
+    DefaultPackageServerRepoData defaultPackageServerRepo ->
       E.object
         [ (Utf8.fromChars "repository-type", repositoryTypeEncoder DefaultPackageServer)
-        , (Utf8.fromChars "repository-url", repositoryUrlEncoder (_defaultPackageServerRepoTypeUrl defaultPackageServerRepoData))
+        , (Utf8.fromChars "repository-url", repositoryUrlEncoder (_defaultPackageServerRepoTypeUrl defaultPackageServerRepo))
+        , (Utf8.fromChars "repository-local-name", repositoryLocalNameEncoder (_defaultPackageServerRepoLocalName defaultPackageServerRepo))
         ]
     PZRPackageServerRepoData pzrPackageServerRepo -> 
       E.object
         [ (Utf8.fromChars "repository-type", repositoryTypeEncoder PZRPackageServer)
         , (Utf8.fromChars "repository-url", repositoryUrlEncoder (_pzrPackageServerRepoTypeUrl pzrPackageServerRepo))
+        , (Utf8.fromChars "repository-local-name", repositoryLocalNameEncoder (_pzrPackageServerRepoLocalName pzrPackageServerRepo))
         , (Utf8.fromChars "repository-auth-token", repositoryAuthTokenEncoder (_pzrPackageServerRepoAuthToken pzrPackageServerRepo))
         ]
 
@@ -380,24 +403,27 @@ instance Binary.Binary CustomSingleRepositoryData where
   get = do
     repositoryType <- Binary.get :: Binary.Get RepositoryType
     repositoryUrl <- Binary.get :: Binary.Get RepositoryUrl
+    repositoryLocalName <- Binary.get :: Binary.Get RepositoryLocalName
     case repositoryType of
       DefaultPackageServer ->
-        pure (DefaultPackageServerRepoData (DefaultPackageServerRepo {_defaultPackageServerRepoTypeUrl=repositoryUrl}))
+        pure (DefaultPackageServerRepoData (DefaultPackageServerRepo {_defaultPackageServerRepoTypeUrl=repositoryUrl, _defaultPackageServerRepoLocalName=repositoryLocalName}))
       PZRPackageServer ->
         do
           repositoryAuthToken <- Binary.get :: Binary.Get RepositoryAuthToken
-          pure (PZRPackageServerRepoData (PZRPackageServerRepo {_pzrPackageServerRepoAuthToken=repositoryAuthToken, _pzrPackageServerRepoTypeUrl=repositoryUrl}))
+          pure (PZRPackageServerRepoData (PZRPackageServerRepo {_pzrPackageServerRepoAuthToken=repositoryAuthToken, _pzrPackageServerRepoTypeUrl=repositoryUrl, _pzrPackageServerRepoLocalName=repositoryLocalName}))
 
   put customSingleRepositoryData =
     case customSingleRepositoryData of
       DefaultPackageServerRepoData defaultPackageServerRepo ->
         do
           Binary.put DefaultPackageServer
           Binary.put (_defaultPackageServerRepoTypeUrl defaultPackageServerRepo)
+          Binary.put (_defaultPackageServerRepoLocalName defaultPackageServerRepo)
       PZRPackageServerRepoData pzrPackageServer ->
         do
           Binary.put PZRPackageServer
           Binary.put (_pzrPackageServerRepoTypeUrl pzrPackageServer)
+          Binary.put (_pzrPackageServerRepoLocalName pzrPackageServer)
           Binary.put (_pzrPackageServerRepoAuthToken pzrPackageServer)
 
   -- = TarballType

builder/src/Elm/Details.hs

@@ -189,7 +189,7 @@ load :: Reporting.Style -> BW.Scope -> FilePath -> IO (Either Exit.Details Detai
 load style scope root =
   do  newTime <- File.getTime (root </> "elm.json")
       maybeDetails <- File.readBinary (Stuff.details root)
-      printLog "Made it to LOAD 1"
+      printLog "Finished file operations for generating the Details data structure"
       case maybeDetails of
         Nothing ->
           generate style scope root newTime
@@ -204,7 +204,7 @@ loadForReactorTH :: Reporting.Style -> BW.Scope -> FilePath -> IO (Either Exit.D
 loadForReactorTH style scope root =
   do  newTime <- File.getTime (root </> "elm.json")
       maybeDetails <- File.readBinary (Stuff.details root)
-      printLog "Made it to LOAD 1"
+      printLog "Finished file operations for generating the Details data structure"
       case maybeDetails of
         Nothing ->
           generateForReactorTH style scope root newTime
@@ -333,8 +333,6 @@ verifyApp env time outline@(Outline.AppOutline elmVersion srcDirs direct _ _ _ p
   if elmVersion == V.compiler
   then
     do  stated <- checkAppDeps outline
-        noredinkexists <- Task.io $ Dir.doesDirectoryExist "/home/changlin/.elm/0.19.1/packages/NoRedInk/elm-json-decode-pipeline/1.0.0"
-        Task.io $ printLog (show noredinkexists ++ "does the NoRedInk file path exist before verifying constraints")
         actual <- verifyConstraints env (Map.map Con.exactly stated)
         -- FIXME: Think about what to do with multiple packageOverrides that have the same keys (probably shouldn't be possible?)
         let originalPkgToOverridingPkg = groupByOriginalPkg packageOverrides

builder/src/File.hs

@@ -12,12 +12,14 @@ module File
   , remove
   , removeDir
   , writePackageReturnElmJson
+  , listAllElmFilesRecursively
   )
   where
 
 
 import qualified Codec.Archive.Zip as Zip
 import Control.Exception (catch)
+import Control.Monad (forM)
 import qualified Data.Binary as Binary
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Internal as BS
@@ -284,3 +286,24 @@ removeDir path =
       if exists_
         then Dir.removeDirectoryRecursive path
         else return ()
+
+
+-- RECURSIVE OPERATIONS
+
+
+listAllElmFilesRecursively :: FilePath -> IO [FilePath]
+listAllElmFilesRecursively startPath = do
+    names <- Dir.listDirectory startPath
+    paths <- forM names $ \name -> do
+      let path = startPath </> name
+      isDirectory <- Dir.doesDirectoryExist path
+      if isDirectory
+          then listAllElmFilesRecursively path
+          else 
+            let 
+              (_, ext) = FP.splitExtension path
+            in
+            if ext == ".elm"
+              then pure [path]
+              else pure []
+    return (concat paths)

builder/src/Http.hs

@@ -15,9 +15,11 @@ module Http
   , getArchive
   -- upload
   , upload
+  , uploadWithHeaders
   , filePart
   , jsonPart
   , stringPart
+  , bytesPart
   )
   where
 
@@ -41,6 +43,7 @@ import qualified Network.HTTP.Client.MultipartFormData as Multi
 
 import qualified Json.Encode as Encode
 import qualified Elm.Version as V
+import Data.ByteString (ByteString)
 
 
 
@@ -210,21 +213,25 @@ readArchiveHelp body (AS len sha zip) =
 -- UPLOAD
 
 
-upload :: Manager -> String -> [Multi.Part] -> IO (Either Error ())
-upload manager url parts =
+uploadWithHeaders :: Manager -> String -> [Multi.Part] -> [Header] -> IO (Either Error ())
+uploadWithHeaders manager url parts headers =
   handle (handleSomeException url id) $
   handle (handleHttpException url id) $
   do  req0 <- parseUrlThrow url
       req1 <-
         Multi.formDataBody parts $
           req0
             { method = methodPost
-            , requestHeaders = addDefaultHeaders []
+            , requestHeaders = addDefaultHeaders headers
             , responseTimeout = responseTimeoutNone
             }
       withResponse req1 manager $ \_ ->
         return (Right ())
 
+upload :: Manager -> String -> [Multi.Part] -> IO (Either Error ())
+upload manager url parts =
+  uploadWithHeaders manager url parts []
+
 
 filePart :: String -> FilePath -> Multi.Part
 filePart name filePath =
@@ -243,3 +250,8 @@ jsonPart name filePath value =
 stringPart :: String -> String -> Multi.Part
 stringPart name string =
   Multi.partBS (String.fromString name) (BS.pack string)
+
+
+bytesPart :: String -> FilePath -> ByteString -> Multi.Part
+bytesPart name filePath bytes =
+  Multi.partFileRequestBody (String.fromString name) filePath (RequestBodyBS bytes)

builder/src/Reporting/Exit.hs

@@ -42,6 +42,7 @@ import qualified Network.HTTP.Types.Status as HTTP
 import qualified System.FilePath as FP
 import System.FilePath ((</>), (<.>))
 
+import qualified Data.Utf8 as Utf8
 import qualified Elm.Constraint as C
 import qualified Elm.Magnitude as M
 import qualified Elm.ModuleName as ModuleName
@@ -65,7 +66,7 @@ import Elm.PackageOverrideData (PackageOverrideData(..))
 import Deps.CustomRepositoryDataIO (CustomRepositoriesError(..))
 import qualified Json.Decode as D
 import qualified Reporting.Error.Json
-import Elm.CustomRepositoryData (CustomRepositoryDataParseError (..))
+import Elm.CustomRepositoryData (CustomRepositoryDataParseError (..), RepositoryLocalName)
 
 
 
@@ -395,7 +396,8 @@ data Publish
   -- When publishing with Zokka we have to be careful not to publish to the standard
   -- Elm repository so that we don't end up publishing packages that the vanilla Elm compiler cannot handle
   | PublishToStandardElmRepositoryUsingZokka
-  | PublishWithNoRepositoryUrl
+  | PublishWithNoRepositoryLocalName
+  | PublishUsingRepositoryLocalNameThatDoesntExistInCustomRepositoryConfig RepositoryLocalName [RepositoryLocalName]
   | PublishCustomRepositoryConfigDataError CustomRepositoriesError
 
 
@@ -702,7 +704,7 @@ publishToReport publish =
             \ Elm compiler at the last moment to publish!"
         ]
 
-    PublishWithNoRepositoryUrl ->
+    PublishWithNoRepositoryLocalName ->
       Help.report "PUBLISH WITH NO REPOSITORY URL" Nothing
         "When publishing with Zokka you must provide a repository URL as an argument. For example:"
         [ D.vcat
@@ -714,6 +716,17 @@ publishToReport publish =
             \ custom repositories, which means when publishing you have to specify where to publish!"
         ]
 
+    PublishUsingRepositoryLocalNameThatDoesntExistInCustomRepositoryConfig localNameProvided availableLocalNames ->
+      Help.report "PUBLISH WITH UNRECOGNIZED LOCAL REPOSITORY NAME" Nothing
+      -- FIXME: Add actual path of the custom-repository-config.json
+        ("You provided the local repository name" ++ Utf8.toChars localNameProvided ++ " which does not seem to exist in the custom-package-repository-config.json being used in ELM_HOME. The following local names were found:")
+        [ D.vcat
+          (map (\name -> D.indent 4 $ D.yellow (D.fromChars (Utf8.toChars name))) availableLocalNames)
+        , D.reflow $
+          "This is different from the standard Elm publish command because Zokka allows for\
+          \ custom repositories, which means when publishing you have to specify where to publish!"
+        ]
+
     PublishCustomRepositoryConfigDataError _ ->
       -- FIXME: Add actual error message here
       Help.report "PUBLISH WITH BAD CUSTOM REPOSITORY CONFIGURATION" Nothing