80-col violations.

haskell · Nov 5, 2015 · bbc3638 · bbc3638
1 parent eff215a
commit bbc3638
Showing 1 changed file with 49 additions and 35 deletions.
diff --git a/cabal-install/Distribution/Client/Upload.hs b/cabal-install/Distribution/Client/Upload.hs
@@ -3,7 +3,8 @@
 
 module Distribution.Client.Upload (check, upload, uploadDoc, report) where
 
-import Distribution.Client.Types (Username(..), Password(..),Repo(..),RemoteRepo(..))
+import Distribution.Client.Types ( Username(..), Password(..)
+                                 , Repo(..), RemoteRepo(..) )
 import Distribution.Client.HttpUtils
          ( HttpTransport(..), remoteRepoTryUpgradeToHttps )
 
@@ -28,9 +29,12 @@ import Control.Monad (forM_, when)
 type Auth = Maybe (String, String)
 
 checkURI :: URI
-Just checkURI = parseURI "http://hackage.haskell.org/cgi-bin/hackage-scripts/check-pkg"
+Just checkURI = parseURI $ "http://hackage.haskell.org/cgi-bin/"
+                           ++ "hackage-scripts/check-pkg"
 
-upload :: HttpTransport -> Verbosity -> [Repo] -> Maybe Username -> Maybe Password -> [FilePath] -> IO ()
+upload :: HttpTransport -> Verbosity -> [Repo]
+       -> Maybe Username -> Maybe Password -> [FilePath]
+       -> IO ()
 upload transport verbosity repos mUsername mPassword paths = do
     targetRepo <-
       case [ remoteRepo | Left remoteRepo <- map repoKind repos ] of
@@ -39,7 +43,8 @@ upload transport verbosity repos mUsername mPassword paths = do
     let targetRepoURI = remoteRepoURI targetRepo
         rootIfEmpty x = if null x then "/" else x
         uploadURI = targetRepoURI {
-            uriPath = rootIfEmpty (uriPath targetRepoURI) FilePath.Posix.</> "upload"
+            uriPath = rootIfEmpty (uriPath targetRepoURI)
+                      FilePath.Posix.</> "upload"
         }
     Username username <- maybe promptUsername return mUsername
     Password password <- maybe promptPassword return mPassword
@@ -48,7 +53,9 @@ upload transport verbosity repos mUsername mPassword paths = do
       notice verbosity $ "Uploading " ++ path ++ "... "
       handlePackage transport verbosity uploadURI auth path
 
-uploadDoc :: HttpTransport -> Verbosity -> [Repo] -> Maybe Username -> Maybe Password -> FilePath -> IO ()
+uploadDoc :: HttpTransport -> Verbosity -> [Repo]
+          -> Maybe Username -> Maybe Password -> FilePath
+          -> IO ()
 uploadDoc transport verbosity repos mUsername mPassword path = do
     targetRepo <-
       case [ remoteRepo | Left remoteRepo <- map repoKind repos ] of
@@ -57,11 +64,14 @@ uploadDoc transport verbosity repos mUsername mPassword path = do
     let targetRepoURI = remoteRepoURI targetRepo
         rootIfEmpty x = if null x then "/" else x
         uploadURI = targetRepoURI {
-            uriPath = rootIfEmpty (uriPath targetRepoURI) FilePath.Posix.</> "package/" ++ pkgid ++ "/docs"
+            uriPath = rootIfEmpty (uriPath targetRepoURI)
+                      FilePath.Posix.</> "package/" ++ pkgid ++ "/docs"
         }
-        (reverseSuffix, reversePkgid) = break (== '-') (reverse (takeFileName path))
+        (reverseSuffix, reversePkgid) = break (== '-')
+                                        (reverse (takeFileName path))
         pkgid = reverse $ tail reversePkgid
-    when (reverse reverseSuffix /= "docs.tar.gz" || null reversePkgid || head reversePkgid /= '-') $
+    when (reverse reverseSuffix /= "docs.tar.gz"
+          || null reversePkgid || head reversePkgid /= '-') $
       die "Expected a file name matching the pattern <pkgid>-docs.tar.gz"
     Username username <- maybe promptUsername return mUsername
     Password password <- maybe promptPassword return mPassword
@@ -74,10 +84,11 @@ uploadDoc transport verbosity repos mUsername mPassword path = do
     notice verbosity $ "Uploading documentation " ++ path ++ "... "
     resp <- putHttpFile transport verbosity uploadURI path auth headers
     case resp of
-      (200,_)     -> do notice verbosity "Ok"
-      (code,err)  -> do notice verbosity $ "Error uploading documentation " ++ path ++ ": "
-                                    ++ "http code " ++ show code ++ "\n"
-                                    ++ err
+      (200,_)     -> notice verbosity "Ok"
+      (code,err)  -> notice verbosity $ "Error uploading documentation "
+                                        ++ path ++ ": "
+                                        ++ "http code " ++ show code ++ "\n"
+                                        ++ err
 
 promptUsername :: IO Username
 promptUsername = do
@@ -98,27 +109,30 @@ promptPassword = do
 
 report :: Verbosity -> [Repo] -> Maybe Username -> Maybe Password -> IO ()
 report verbosity repos mUsername mPassword = do
-      Username username <- maybe promptUsername return mUsername
-      Password password <- maybe promptPassword return mPassword
-      let auth = (username,password)
-      forM_ repos $ \repo -> case repoKind repo of
-        Left remoteRepo
-            -> do dotCabal <- defaultCabalDir
-                  let srcDir = dotCabal </> "reports" </> remoteRepoName remoteRepo
-                  -- We don't want to bomb out just because we haven't built any packages from this repo yet
-                  srcExists <- doesDirectoryExist srcDir
-                  when srcExists $ do
-                    contents <- getDirectoryContents srcDir
-                    forM_ (filter (\c -> takeExtension c == ".log") contents) $ \logFile ->
-                        do inp <- readFile (srcDir </> logFile)
-                           let (reportStr, buildLog) = read inp :: (String,String)
-                           case BuildReport.parse reportStr of
-                             Left errs -> warn verbosity $ "Errors: " ++ errs -- FIXME
-                             Right report' ->
-                                 do info verbosity $ "Uploading report for " ++ display (BuildReport.package report')
-                                    BuildReport.uploadReports verbosity auth (remoteRepoURI remoteRepo) [(report', Just buildLog)]
-                                    return ()
-        Right{} -> return ()
+  Username username <- maybe promptUsername return mUsername
+  Password password <- maybe promptPassword return mPassword
+  let auth = (username,password)
+  forM_ repos $ \repo -> case repoKind repo of
+    Left remoteRepo ->
+      do dotCabal <- defaultCabalDir
+         let srcDir = dotCabal </> "reports" </> remoteRepoName remoteRepo
+         -- We don't want to bomb out just because we haven't built any packages
+         -- from this repo yet.
+         srcExists <- doesDirectoryExist srcDir
+         when srcExists $ do
+           contents <- getDirectoryContents srcDir
+           forM_ (filter (\c -> takeExtension c ==".log") contents) $ \logFile ->
+             do inp <- readFile (srcDir </> logFile)
+                let (reportStr, buildLog) = read inp :: (String,String)
+                case BuildReport.parse reportStr of
+                  Left errs -> warn verbosity $ "Errors: " ++ errs -- FIXME
+                  Right report' ->
+                    do info verbosity $ "Uploading report for "
+                         ++ display (BuildReport.package report')
+                       BuildReport.uploadReports verbosity auth
+                         (remoteRepoURI remoteRepo) [(report', Just buildLog)]
+                       return ()
+    Right{} -> return ()
 
 check :: HttpTransport -> Verbosity -> [FilePath] -> IO ()
 check transport verbosity paths =
@@ -133,5 +147,5 @@ handlePackage transport verbosity uri auth path =
      case resp of
        (200,_)     -> notice verbosity "Ok"
        (code,err)  -> notice verbosity $ "Error uploading " ++ path ++ ": "
-                                     ++ "http code " ++ show code ++ "\n"
-                                     ++ err
+                      ++ "http code " ++ show code ++ "\n"
+                      ++ err