Minor updates for (String <-> Text <-> Name) changes in compiler

Author: evancz

src/backend/Package/Register.hs

@@ -108,11 +108,11 @@ badNameMessage name problem =
 verifyVersion :: Http.Token -> Memory.Memory -> Pkg.Name -> Text -> Text -> Snap.Snap Pkg.Version
 verifyVersion token memory name commitHash rawVersion =
   case Pkg.versionFromText rawVersion of
-    Left problem ->
+    Nothing ->
       Error.string 400 $
-        "I was given an invalid version: " ++ Text.unpack rawVersion ++ "\n\n" ++ problem
+        "I was given an invalid version: " ++ Text.unpack rawVersion
 
-    Right version ->
+    Just version ->
       do  verifyIsNew memory name version
           verifyTag token name version commitHash
           return version
@@ -147,15 +147,15 @@ getCommitHash token name version =
           Error.bytestring 500 "Request to GitHub API failed."
 
         Right body ->
-          case Decode.parse tagDecoder body of
+          case Decode.parse tagDecoder (LBS.toStrict body) of
             Right hash ->
               return hash
 
             Left _ ->
               Error.bytestring 500 "Request to GitHub API failed due to unexpected JSON."
 
 
-tagDecoder :: Decode.Decoder Text
+tagDecoder :: Decode.Decoder e Text
 tagDecoder =
   Decode.at ["object","sha"] Decode.text
 
@@ -184,7 +184,7 @@ uploadFiles name version time =
           if Set.fromList files /= requiredFiles then
             revert dir $ "Malformed request. Missing some metadata files."
           else
-            do  bytes <- liftIO $ LBS.readFile (dir </> "elm.json")
+            do  bytes <- liftIO $ BS.readFile (dir </> "elm.json")
                 case Decode.parse Project.pkgDecoder bytes of
                   Left _ ->
                     revert dir $ "Invalid content in elm.json file."
@@ -279,13 +279,13 @@ writeEndpoint name version dir stream =
                   Right hash ->
                     do  Encode.writeUgly (dir </> "endpoint.json") $
                           Encode.object
-                            [ ("url", Encode.string (toGithubUrl name version))
+                            [ ("url", Encode.text (toGithubUrl name version))
                             , ("hash", Encode.text hash)
                             ]
 
                         return $ Right "endpoint.json"
 
 
-toGithubUrl :: Pkg.Name -> Pkg.Version -> String
+toGithubUrl :: Pkg.Name -> Pkg.Version -> Text.Text
 toGithubUrl name version =
-  "https://github.com/" ++ Pkg.toUrl name ++ "/zipball/temp-" ++ Pkg.versionToString version ++ "/"
+  "https://github.com/" <> Text.pack (Pkg.toUrl name) <> "/zipball/temp-" <> Pkg.versionToText version <> "/"

src/backend/Package/Releases.hs

@@ -11,11 +11,9 @@ module Package.Releases
 
 import Prelude hiding (read)
 import Control.Monad (forM)
-import qualified Data.ByteString.Lazy as BS
+import qualified Data.ByteString as BS
 import qualified Data.HashMap.Lazy as HashMap
 import qualified Data.List as List
-import Data.Monoid ((<>))
-import qualified Data.Text as Text
 import qualified Data.Time.Clock.POSIX as Time
 import System.Directory (doesFileExist)
 import System.Exit (exitFailure)
@@ -74,16 +72,16 @@ add name version time =
 encode :: [Release] -> Encode.Value
 encode releases =
   Encode.object $ flip map (List.sort releases) $ \(Release version time) ->
-    ( Pkg.versionToString version, Encode.int (floor time) )
+    ( Pkg.versionToText version, Encode.int (floor time) )
 
 
-releasesDecoder :: Decode.Decoder [Release]
+releasesDecoder :: Decode.Decoder () [Release]
 releasesDecoder =
   do  pairs <- HashMap.toList <$> Decode.dict Decode.int
       forM (List.sort pairs) $ \(vsn, int) ->
         case Pkg.versionFromText vsn of
-          Left _ ->
-            Decode.fail $ Text.unpack vsn <> " is not a valid version"
-
-          Right version ->
+          Just version ->
             Decode.succeed (Release version (fromIntegral int))
+
+          Nothing ->
+            Decode.fail ()

src/backend/Server.hs

@@ -1,6 +1,10 @@
 {-# OPTIONS_GHC -Wall #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Server (serve) where
+module Server
+  ( serve
+  )
+  where
+
 
 import Data.Foldable (asum)
 import qualified Data.List as List
@@ -88,7 +92,7 @@ data Vsn = Latest | Exactly Pkg.Version
 
 versionRoute :: Route (Pkg.Version -> a) a
 versionRoute =
-  Router.custom (either (\_ -> Nothing) Just . Pkg.versionFromText)
+  Router.custom Pkg.versionFromText
 
 
 versionStuff :: Route (PkgInfo -> a) a
@@ -154,7 +158,7 @@ serveVersionHelp name version maybeAsset =
       serveFile (Path.directory name version ++ "/README.md")
 
     Just asset ->
-      case Module.dehyphenate asset of
+      case Module.fromHyphenPath asset of
         Nothing ->
           S.pass