Reformat with hindent

tfausak · Dec 30, 2016 · 83418b3 · 83418b3
1 parent f5514f4
commit 83418b3
Show file tree

Hide file tree

Showing 2 changed files with 92 additions and 76 deletions.
diff --git a/source/executable/Main.hs b/source/executable/Main.hs
@@ -1,3 +1,5 @@
-module Main (module GitHubRelease) where
+module Main
+  ( module GitHubRelease
+  ) where
 
 import GitHubRelease (main)
diff --git a/source/library/GitHubRelease.hs b/source/library/GitHubRelease.hs
@@ -5,6 +5,8 @@
 
 module GitHubRelease where
 
+import Options.Generic (type (<?>))
+
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Char8 as BS8
 import qualified Data.ByteString.Lazy as BSL
@@ -24,33 +26,27 @@ import qualified System.IO as IO
 import qualified Text.Printf as Printf
 
 data Command
-    = Upload
-        { file :: FilePath Options.<?>
-            "The path to the local file to upload."
-        , name :: String Options.<?>
-            "The name to give the file on the release."
-        , owner :: String Options.<?>
-            "The GitHub owner, either a user or organization."
-        , repo :: String Options.<?>
-            "The GitHub repository name."
-        , tag :: String Options.<?>
-            "The tag name."
-        , token :: String Options.<?>
-            "Your OAuth2 token."
-        }
-    | Version
-    deriving (Generics.Generic, Show)
+  = Upload { file :: FilePath <?> "The path to the local file to upload."
+          ,  name :: String <?> "The name to give the file on the release."
+          ,  owner :: String <?> "The GitHub owner, either a user or organization."
+          ,  repo :: String <?> "The GitHub repository name."
+          ,  tag :: String <?> "The tag name."
+          ,  token :: String <?> "Your OAuth2 token."}
+  | Version
+  deriving (Generics.Generic, Show)
 
 instance Options.ParseRecord Command
 
 main :: IO ()
 main = do
-    command <- Options.getRecord (Text.pack "Upload a file to a GitHub release.")
-    runCommand command
+  command <- Options.getRecord (Text.pack "Upload a file to a GitHub release.")
+  runCommand command
 
 runCommand :: Command -> IO ()
-runCommand command = case command of
-    Upload aFile aName anOwner aRepo aTag aToken -> upload
+runCommand command =
+  case command of
+    Upload aFile aName anOwner aRepo aTag aToken ->
+      upload
         (Options.unHelpful aToken)
         (Options.unHelpful anOwner)
         (Options.unHelpful aRepo)
@@ -61,77 +57,95 @@ runCommand command = case command of
 
 upload :: String -> String -> String -> String -> FilePath -> String -> IO ()
 upload aToken anOwner aRepo aTag aFile aName = do
-    manager <- Client.newManager TLS.tlsManagerSettings
-    uploadUrl <- getUploadUrl manager aToken anOwner aRepo aTag
-    response <- uploadFile manager uploadUrl aToken aFile aName
-    case HTTP.statusCode (Client.responseStatus response) of
-        201 -> pure ()
-        _ -> do
-            IO.hPrint IO.stderr response
-            BSL.hPutStr IO.stderr (Client.responseBody response)
-            fail "Failed to upload file to release!"
-
-getUploadUrl :: Client.Manager -> String -> String -> String -> String -> IO Template.UriTemplate
+  manager <- Client.newManager TLS.tlsManagerSettings
+  uploadUrl <- getUploadUrl manager aToken anOwner aRepo aTag
+  response <- uploadFile manager uploadUrl aToken aFile aName
+  case HTTP.statusCode (Client.responseStatus response) of
+    201 -> pure ()
+    _ -> do
+      IO.hPrint IO.stderr response
+      BSL.hPutStr IO.stderr (Client.responseBody response)
+      fail "Failed to upload file to release!"
+
+getUploadUrl
+  :: Client.Manager
+  -> String
+  -> String
+  -> String
+  -> String
+  -> IO Template.UriTemplate
 getUploadUrl manager aToken anOwner aRepo aTag = do
-    (Right json) <- getTag manager aToken anOwner aRepo aTag
-    let (Just (Aeson.String text)) = HashMap.lookup (Text.pack "upload_url") json
-    let uploadUrl = Text.unpack text
-    let (Right template) = Template.parseTemplate uploadUrl
-    pure template
+  (Right json) <- getTag manager aToken anOwner aRepo aTag
+  let (Just (Aeson.String text)) = HashMap.lookup (Text.pack "upload_url") json
+  let uploadUrl = Text.unpack text
+  let (Right template) = Template.parseTemplate uploadUrl
+  pure template
 
-getTag :: Client.Manager -> String -> String -> String -> String -> IO (Either String Aeson.Object)
+getTag
+  :: Client.Manager
+  -> String
+  -> String
+  -> String
+  -> String
+  -> IO (Either String Aeson.Object)
 getTag manager aToken anOwner aRepo aTag = do
-    let format = "https://api.github.com/repos/%s/%s/releases/tags/%s"
-    let url = Printf.printf format anOwner aRepo aTag
-    initialRequest <- Client.parseUrlThrow url
-    let request = initialRequest
-            { Client.requestHeaders =
-                [ authorizationHeader aToken
-                , userAgentHeader
-                ]
-            }
-    response <- Client.httpLbs request manager
-    let body = Client.responseBody response
-    let json = Aeson.eitherDecode body
-    return json
+  let format = "https://api.github.com/repos/%s/%s/releases/tags/%s"
+  let url = Printf.printf format anOwner aRepo aTag
+  initialRequest <- Client.parseUrlThrow url
+  let request =
+        initialRequest
+        {Client.requestHeaders = [authorizationHeader aToken, userAgentHeader]}
+  response <- Client.httpLbs request manager
+  let body = Client.responseBody response
+  let json = Aeson.eitherDecode body
+  return json
 
 authorizationHeader :: String -> HTTP.Header
 authorizationHeader aToken =
-    ( HTTP.hAuthorization
-    , BS8.pack (Printf.printf "token %s" aToken)
-    )
+  (HTTP.hAuthorization, BS8.pack (Printf.printf "token %s" aToken))
 
 userAgentHeader :: HTTP.Header
-userAgentHeader =
-    ( HTTP.hUserAgent
-    , BS8.pack userAgent
-    )
+userAgentHeader = (HTTP.hUserAgent, BS8.pack userAgent)
 
 userAgent :: String
 userAgent = Printf.printf "%s/%s-%s" "tfausak" "github-release" versionString
 
 versionString :: String
 versionString = Version.showVersion This.version
 
-uploadFile :: Client.Manager -> Template.UriTemplate -> String -> FilePath -> String -> IO (Client.Response BSL.ByteString)
+uploadFile
+  :: Client.Manager
+  -> Template.UriTemplate
+  -> String
+  -> FilePath
+  -> String
+  -> IO (Client.Response BSL.ByteString)
 uploadFile manager template aToken aFile aName = do
-    contents <- BSL.readFile aFile
-    let body = Client.RequestBodyLBS contents
-    uploadBody manager template aToken body aName
+  contents <- BSL.readFile aFile
+  let body = Client.RequestBodyLBS contents
+  uploadBody manager template aToken body aName
 
-uploadBody :: Client.Manager -> Template.UriTemplate -> String -> Client.RequestBody -> String -> IO (Client.Response BSL.ByteString)
+uploadBody
+  :: Client.Manager
+  -> Template.UriTemplate
+  -> String
+  -> Client.RequestBody
+  -> String
+  -> IO (Client.Response BSL.ByteString)
 uploadBody manager template aToken body aName = do
-    let url = Template.render template
-            [ ("name", Template.WrappedValue (Template.Single aName))
+  let url =
+        Template.render
+          template
+          [("name", Template.WrappedValue (Template.Single aName))]
+  initialRequest <- Client.parseUrlThrow url
+  let request =
+        initialRequest
+        { Client.method = BS8.pack "POST"
+        , Client.requestBody = body
+        , Client.requestHeaders =
+            [ authorizationHeader aToken
+            , (HTTP.hContentType, MIME.defaultMimeLookup (Text.pack aName))
+            , userAgentHeader
             ]
-    initialRequest <- Client.parseUrlThrow url
-    let request = initialRequest
-            { Client.method = BS8.pack "POST"
-            , Client.requestBody = body
-            , Client.requestHeaders =
-                [ authorizationHeader aToken
-                , (HTTP.hContentType, MIME.defaultMimeLookup (Text.pack aName))
-                , userAgentHeader
-                ]
-            }
-    Client.httpLbs request manager
+        }
+  Client.httpLbs request manager